Solved Need Row 1 data from multiple spreadsheets/books to 1 sheet

July 24, 2012 at 11:09:27
Specs: Windows XP

I have multiple workbooks that each have multiple sheets.
I would like to capture all of the Row 1 data from each of those sheets on one Master spreadsheet.
No computing needed; just don't want to copy/paste 250 times.

Many thanks in advance!

See More: Need Row 1 data from multiple spreadsheets/books to 1 sheet

Report •

July 24, 2012 at 15:12:05
✔ Best Answer
I can't take credit for the original code, but I did modify it to copy Row 1 of each sheet from each .xlsx file in the referenced folder into Sheet 1 of the workbook in which the code resides.

I suggest that you try this in a new workbook so that you don't overwrite anything in a existing workbook in case things go terribly wrong.

All of the files you are copying from have to reside in the same folder and you have to change this line to reflect that folder:

Const strPath As String = "C:\Documents and Settings\DerbyDad03\Test Folder\"

The original code can be found here:

Sub CopySameSheetFrmWbs()
Dim wbOpen As Workbook
'Change Path
Const strPath As String = "C:\Documents and Settings\DerbyDad03\Test Folder\"

Dim strExtension As String

'Comment out the 3 lines below to debug
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next

    ChDir strPath
'Change extension if required
strExtension = Dir("*.xlsx")
'Loop through .xlsx files in folder
        Do While strExtension <> ""
            Set wbOpen = Workbooks.Open(strPath & strExtension)
'Open each source workbook, loop through sheets, copy Row 1, Close source
            With wbOpen
                For sht = 1 To .Sheets.Count
                 nxtDstRw = nxtDstRw + 1
                   .Sheets(sht).Rows(1).EntireRow.Copy _
                      Destination:=ThisWorkbook.Sheets(1).Cells(nxtDstRw, 1)
                .Close SaveChanges:=False
            End With
            strExtension = Dir
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
On Error GoTo 0
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Report •

July 25, 2012 at 08:10:30
You have my praise and adulation!
This was my first post here and I am not terribly handy with Excel and yet I was able to get it going with your help.
Thank you ever so much!

Report •

Related Solutions

Ask Question