copy rows from 42 workbooks into masterworkbook

Hey

I,m looking for a more elegant solution to the macro pasted below. The idea is to copy 6 rows from 42 workbooks in one single workbook without having to copy the below macro 42 times. All files will be in one folder. So the steps will be:

1 open first workbook
2 mark rows
3 copy rows
4 insert into active workbook
5 close workbook
6 repeat 42 times with every file in directory

    Workbooks.Open Filename:= _
        "\\c\folder\filename 1.xlsm"
    Range("13:15,30:32").Select
    Range("A30").Activate
    Selection.EntireRow.Hidden = False
    Selection.Copy
    Windows("Book1").Activate
    Rows("3:3").Select
    ActiveSheet.Paste
    Windows("filename 1.xlsm").Activate
    Range("B4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Book1").Activate
    Range("A3:A8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("filename 1.xlsm").Activate
    ActiveWindow.Close
    
    Workbooks.Open Filename:= _
        "\\c\foldername\filename 2.xlsm"
    Range("13:15,30:32").Select
    Range("A30").Activate
    Selection.EntireRow.Hidden = False
    Selection.Copy
    Windows("Book1").Activate
    Rows("9:9").Select
    ActiveSheet.Paste
    Windows("Trafikkinntektsmodell B2013 AT.xlsm").Activate
    Range("B4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Book1").Activate
    Range("A9:A14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("filename 2.xlsm").Activate
    ActiveWindow.Close

Something like this should work:

Option Explicit

Sub ImportData()
'This macro is installed into the master workbook

Dim fPATH As String, fNAME As String, NR As Long
Dim wbDATA As Workbook, wsMASTER As Worksheet

Set wsMASTER = ThisWorkbook.Sheets("Sheet1")                'edit this to the name of the master sheet
NR = wsMASTER.Range("A" & Rows.Count).End(xlUp).Row + 1     'next empty row on the master sheet

fPATH = "\\c\folder\"                                       'path to all files
fNAME = Dir(fPATH & "*.xls*")                               'get the first filename from the folder

Do While Len(fNAME) > 0                                     'process one file at a time til no more filenames
    Set wbDATA = Workbooks.Open(fPATH * fNAME)              'open the found file
    With Range("13:15,30:32")
        .EntireRow.Hidden = False                           'unhide the rows
        .Copy wsMASTER.Range("A" & NR)                      'copy into master sheet to empty rows
    End With
    wsMASTER.Range("A" & NR).Resize(6).Value = Range("B4").Value    'add key value in column A

    wbDATA.Close False                                      'close the found file
    NR = wsMASTER.Range("A" & Rows.Count).End(xlUp).Row + 1 'next empty row on the master sheet
    fNAME = Dir                                             'get the next filename
Loop

End Sub

Hmmm. no luck. what if i upload master workbook and one of the dataimport workbooks?

Describe what "no luck" means.

no execution of makro. Just to clarify under statement

                fNAME = Dir(fPATH & "*.xls*")                               'get the first filename from the folder

I replace everything inside the colon with whole filename? the first filename in the folder is "trafikkinntektsmodell B2013 AL.xlsm". Every file after that will have same name except the two letter abbreviation

That line of code should work just fine. The * wildcards in the filename should allow any names. You could be a little more specific, but it's not really necessary:

                fNAME = Dir(fPATH & "trafikkinntektsmodell*.xls*")                               'get the first filename from the folder

I would recommend using F8 to step through that macro one line of code at a time and see which line of code does NOT do what it is supposed to. After you pass the Fname = code, hover your mouse over fNAME and you should see the name of the file it found. Anything?

So, VBA is not finding any files in that folder. You did edit the folder highlighted in red in the original macro to point to your actual folder?

I don't do any "over network" work, so if the problem is related to running the VBA over a network path I won't be much help with that. Only tip I can think of would be to map the network drive to your own system as new drive so you can use standard Windows path formatting:

fPATH = "C:\Path\To\My\Files\"

ok, well, I use this kind of code in 100s of macros. Something doesn't match what is actually in your working environment.

Strange. If could use the rest of the code after this then... would that work? And copy 42 times with but just changing filename?

 Sub ImportData()
'This macro is installed into the master workbook

    Dim NR As Long
    Dim wbDATA As Workbook, wsMASTER As Worksheet

    Set wsMASTER = ThisWorkbook.Sheets("calc")                'edit this to the name of the master sheet
    NR = wsMASTER.Range("A" & Rows.Count).End(xlUp).Row + 1     'next empty row on the master sheet

    Set wbDATA = Workbooks.Open("\\sgm434\avdelinger2$\CA\RL\Stab RL\Controller\2013\Budsjett\Trafikk\Samtlige\trafikkinntektsmodell B2013 AL.xlsm")              'open the found file
    With Range("13:15,30:32")
        .EntireRow.Hidden = False                           'unhide the rows
        .Copy wsMASTER.Range("A" & NR)                      'copy into master sheet to empty rows
    End With
    wsMASTER.Range("A" & NR).Resize(6).Value = Range("B4").Value    'add key value in column A

    wbDATA.Close False                                      'close the found file
    NR = wsMASTER.Range("A" & Rows.Count).End(xlUp).Row + 1 'next empty row on the master sheet

Ok, I've added code tags to TWO of your prior posts. It's your turn. Please correct the post above as per forum rules.

EDIT post #15, highlight the code, click the # icon.

Take a moment and read through the forum rules, you are expected to know and follow them. Thanks.

Ping back when you have corrected it.

I have marked this thread solved for you.
In the future please select Thread Tools from the menu above and mark the thread as solved. Thanks.