Adding the workbook name to column F VBA

[fawnlemur]

Hi

I'm using the below code to copy data from multiple spreadsheets into a master spreadsheet. It works fine but I want to add a column (F) to state which workbook it was copied from. can some one please help me with that.

so if data was copied from workbook1 column F would say workbook1.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Dim i As Long
    i = 999999
    Range("A2:G" & i).Clear 'ClearContents
    Const strPath As String = "Link Here"
    ChDir strPath
    strExtension = Dir("*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("CASE LOG").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("CASE LOG").Range("A3:E" & LastRow).Copy wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
     
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
Application.ScreenUpdating = True
End Sub

 

[Fluff]

Try

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long, LastRow2 As Long
    Dim i As Long
    i = 999999
    Range("A2:G" & i).Clear 'ClearContents
    Const strPath As String = "Link Here"
    ChDir strPath
    strExtension = Dir("*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("CASE LOG").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            LastRow2 = wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
            .Sheets("CASE LOG").Range("A3:E" & LastRow).Copy wkbDest.Sheets("Master").Cells(LastRow2, "A")
            wkbDest.Sheets("Master").Cells(LastRow2, "F").Resize(LastRow - 2).Value = .Name
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
Application.ScreenUpdating = True
End Sub

 

[fawnlemur]

Thanks this works

 

[Fluff]

You're welcome & thanks for the feedback