Master excel workbook from multiple excel workbooks

user12

New Member
Joined
May 16, 2019
Messages
7
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?
 

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
11,774
Office Version
2013
Platform
Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,095,724
Messages
5,446,145
Members
405,384
Latest member
geowbadyt

This Week's Hot Topics

Top