Master excel workbook from multiple excel workbooks

user12

New Member
Joined
May 16, 2019
Messages
7
I am trying to automatically transfer data from multiple workbooks into one master workbook. All workbooks are in the same folder. The data is off various column and row size and contained on only one sheet in each workbook. There are a total of 6 worksheets in the master. Example of what exactly I am trying to do is shown below. Each data set will be organized based on text found in cell C5. Any help would be greatly appreciated.

Master

Sheet1 Sheet2 Sheet3

Workbook A(C6:AA500) Workbook D(C6:AF500) Workbook Q(C6:AJ500)
Workbook C(C6:AA567) Workbook J(C6:AF567) Workbook W(C6:AJ567)


Sheet4 Sheet5 Sheet6

Workbook H(C6:AD400) Workbook S(C6:Z457) Workbook F(C6:AA500)
Workbook G(C6:AD789) Workbook N(C6:Z675) Workbook R(C6:AA567)
 
Your original post indicated that you wanted to copy from Cell C6 to that last row and las colomn of the used range. To change the starting point of the upper left cell of the copy range, change the cell reference in red font below. You did not specify a destination range, so I assumed it to be column A in th master file sheets.
Code:
Sub cpySource()
Dim sh As Worksheet, fName As String, fPath As String, wb As Workbook, lr As Long, lc As Long, ssh As Worksheet
fPath = ThisWorkbook.Path & "\"
fName = Dir(fPath & "*[COLOR=#ff0000][B].xl[/B][/COLOR]*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName) 'Opens target workbooks one at a time
            Select Case wb.Sheets(1).Range("C5").Value 'This will designate the destination sheet
                Case "Larry"
                    Set sh = ThisWorkbook.Sheets("Sheet1")
                Case "Alice"
                    Set sh = ThisWorkbook.Sheets("Sheet2")
                Case "SOF"
                    Set sh = ThisWorkbook.Sheets("Sheet3")
                Case "Coke"
                    Set sh = ThisWorkbook.Sheets("Sheet4")
                Case "SWELL"
                    Set sh = ThisWorkbook.Sheets("Sheet5")
                Case "Britta"
                    Set sh = ThisWorkbook.Sheets("Sheet6")
                Case Else   'In case no entry or bad entry is in cell C5
                    MsgBox "No Match in Cell C5 for " & wb.Name, vbExclamation, "MISMATCH" 
                    wb.Close False
                    GoTo SKIP:
            End Select
            Set ssh = wb.Sheets(1)  'Put source sheet in a variable
            lc = ssh.Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column  'get last column of source sheet
            lr = ssh.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row  'get last row of source sheet
            With ssh
                .Range("[COLOR=#ff0000]B6[/COLOR]", .Cells(lr, lc)).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)  'execute copy/paste
            End With
            wb.Close False
                End If
SKIP:
        fName = Dir
    Loop
End Sub


So I forgot to mention that the other workboooks are saved as microsoft excel csv documents. So right now your code is not working at all for me, could it be because of this?
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Did you try changing this
Code:
fName = Dir(fPath & "*[COLOR=#ff0000][B].xl[/B][/COLOR]*")
to this

fNa
Code:
me = Dir(fPath & "*[COLOR=#ff0000][B].csv")[/B][/COLOR]
to see if it made a difference? If not, try it. If the files were Excel workbooks saved as .csv then it should work.
 
Upvote 0

Forum statistics

Threads
1,214,381
Messages
6,119,192
Members
448,874
Latest member
Lancelots

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top