Pull data from multiple files with multiple unknown sheet names in each

[cjouban]

Sorry if I missed a thread that solves this. I am trying to copy same cell in multiple workbooks with multiple sheets to a new workbook. I've found examples that require a sheet name but I have know idea what each sheet is named. The macro needs to work it's way through all files in a folder and each sheet in the file pasting the results in a new workbook. Thanks in advance for any help.

 

[Fluff]

When you get the error, click the debug button & it will highlight the problem line. Which line gets highlighted? Also What is the error message?

 

[cjouban]

Run-time error 424
Object required

 

[Fluff]

I don't see how you get that error on that line.
Did you run the macro & then click the debug button?

 

[cjouban]

I changed the error trapping to "Break on All Errors". Now I get the debug button. It wasn't showing up before.
The error is on this line
NxtRw = destws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row

 

[Fluff]

Oops, typo on my part, it should be

NxtRw = desWS.Range("A" & Rows.Count).End(xlUp).Offset(1).Row

 

[cjouban]

Success!!! Thanks again for your help.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, ws As Worksheet
    Set desWS = ThisWorkbook.Sheets("Sheet1")
    Dim FolderName As String
    Dim NxtRw As Long
   NxtRw = desWS.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .Show
       FolderName = .SelectedItems(1) & "\"
    End With
    ChDir FolderName
    strExtension = Dir("*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(FolderName & strExtension)
        For Each ws In Sheets
             With ws
                desWS.Cells(NxtRw, "A") = .Range("A1")
                desWS.Cells(NxtRw, "B") = .Range("A2")
                desWS.Cells(NxtRw, "C") = .Range("A3")
                desWS.Cells(NxtRw, "D") = .Range("A4")
                NxtRw = NxtRw + 1
            End With
        Next ws
        srcWB.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

You're welcome & thanks for the feedback