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

cjouban

New Member
Joined
Jan 21, 2014
Messages
23
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.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,434
What is the cell you want to copy? Where in the destination sheet do you want to paste the cells values? What is the full path to the folder containing the files? What is the extension of the files (xlsx, xlsm)?
 

cjouban

New Member
Joined
Jan 21, 2014
Messages
23
There are multiple cells I want to copy. For this let's say A1, A3, B2 & B4.
The destination sheet is the active workbook where I run the macro. Paste each copied cell in the next blank row.
The path will change. I was going to update it each time.
The files are xlsx

Thank you
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,434
Place this macro in the active workbook and rename one sheet as "Summary". When you run the macro you will be prompted to select the folder containing your files.
Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, ws As Worksheet
    Set desWS = ThisWorkbook.Sheets("Summary")
    Dim FolderName As String
    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(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0) = .Range("A1")
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0) = .Range("A3")
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0) = .Range("B2")
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0) = .Range("B4")
            End With
        Next ws
        srcWB.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 

cjouban

New Member
Joined
Jan 21, 2014
Messages
23
I changed the desWS name and and destination range to run a test. The srcWB opens but nothing is copied to desWS. It doesn't produce any errors.

VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, ws As Worksheet
    Set desWS = ThisWorkbook.Sheets("Sheet1")
    Dim FolderName As String
    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(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0) = .Range("A1")
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0) = .Range("A2")
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0) = .Range("A3")
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0) = .Range("A4")
            End With
        Next ws
        srcWB.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,434
I tested the macro on some dummy files and it worked properly. Do you have data in the cells you want to copy.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,247
Office Version
365
Platform
Windows
Is that code in the destination workbook, or is it in a different workbook, such as your Personal.xlsb?
 

cjouban

New Member
Joined
Jan 21, 2014
Messages
23
Is that code in the destination workbook, or is it in a different workbook, such as your Personal.xlsb?
Good catch. It was in my Personal. Moved it to the workbook Sheet 1 and it worked. Thank you. This forum is great. Thanks again Mumps and Fluff.

VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, ws As Worksheet
    Set desWS = ThisWorkbook.Sheets("Sheet1")
    Dim FolderName As String
    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(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0) = .Range("A1")
                desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0) = .Range("A2")
                desWS.Cells(desWS.Rows.Count, "C").End(xlUp).Offset(1, 0) = .Range("A3")
                desWS.Cells(desWS.Rows.Count, "D").End(xlUp).Offset(1, 0) = .Range("A4")
            End With
        Next ws
        srcWB.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 

Forum statistics

Threads
1,077,825
Messages
5,336,595
Members
399,090
Latest member
Mcoca

Some videos you may like

This Week's Hot Topics

Top