Copy File Names to Destination File

Question

Hope all good with everyone.

I am trying to copy/paste file name to my destination workbook's column A. Below is copying data from all workbooks from a folder and pastes them to my masterfile.

Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Const strPath As String = "folder of data files"
    ChDir strPath
    strExtension = Dir("*.csv*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("ADJUSTMENTS_EXTR").Cells.Find("Total", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("ADJUSTMENTS_EXTR").Range("A10:V" & LastRow).Copy wkbDest.Sheets("Consolidated Data").Cells(Rows.Count, "B").End(xlUp).Offset(0, 0)
            .wkbDest.Range("A2" & LastRow) = wkbSource.Name
            **'.wkbDest.Sheets("Consolidated Data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = wkbSource.Name**
            .Close savechanges:=False
        End With
        
        
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True

There are usually 5-6 files under data folder. Aim is to while copying data, I also need each files name at my master file's column A alongside with data. below is what I tried. Unfortunately couldnt make it work. Thanks in advance.

.wkbDest.Sheets("Consolidated Data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = wkbSource.Name**

Answer 1

Copy Values From Closed Files

Sources

Destination

Sub RetrieveData()
    
    Const PROC_TITLE As String = "Retrieve Data"
    
    ' Define constants.
    
    ' Source
    Const SRC_FOLDER_PATH As String = "C:\Test\"
    Const SRC_DIR_PATTERN As String = "*.csv"
    Const SRC_TOTALS_ROW_IDENTIFIER As String = "Total"
    Const SRC_TOTALS_ROW_OFFSET As Long = 1 ' 0 to copy totals row
    Const SRC_FIRST_ROW As Long = 10
    Const SRC_COLUMNS As String = "A:V"
    ' Destination
    Const DST_SHEET_NAME As String = "Consolidated Data"
    Const DST_FIRST_CELL_ADDRESS As String = "B2"
    Const DST_SOURCE_NAME_COLUMN As String = "A"
    
    Application.ScreenUpdating = False
    
    ' Reference the destination objects.
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dws As Worksheet: Set dws = dwb.Sheets(DST_SHEET_NAME)
    Dim dcell As Range: Set dcell = dws.Range(DST_FIRST_CELL_ADDRESS)
    Dim ColumnsCount As Long: ColumnsCount = dws _
        .Columns(SRC_COLUMNS).Columns.Count
    Dim drrg As Range: Set drrg = dcell.Resize(, ColumnsCount)
    Dim dncell As Range: Set dncell = drrg.Cells(1) _
        .EntireRow.Columns(DST_SOURCE_NAME_COLUMN)
    
    ' Clear existing data.
    
    Dim drCount As Long: drCount = dws.Rows.Count - drrg.Row + 1
    drrg.Resize(drCount).ClearContents
    dncell.Resize(drCount).ClearContents
    
    ' Get the source first file name.
    
    Dim sFileName As String: sFileName = Dir(SRC_FOLDER_PATH & SRC_DIR_PATTERN)
    
    If Len(sFileName) = 0 Then
        MsgBox "No (""" & SRC_DIR_PATTERN & """) files found in """ _
            & SRC_FOLDER_PATH & """!", vbExclamation
        Exit Sub
    End If
    
    ' For each found file, copy...
    
    Dim swb As Workbook, sws As Worksheet, srg As Range, slCell As Range
    Dim sRowsCount As Long, dRowsCount As Long, swsCount As Long
    
    Do While Len(sFileName) > 0
        
        Set swb = Workbooks.Open(Filename:=SRC_FOLDER_PATH & sFileName, Local:=True)
        Set sws = swb.Sheets(1)
        Set slCell = sws.Cells.Find(What:="Total", LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
        
        If Not slCell Is Nothing Then
            sRowsCount = slCell.Row - SRC_TOTALS_ROW_OFFSET - SRC_FIRST_ROW + 1
            If sRowsCount > 0 Then
                Set srg = sws.Rows(SRC_FIRST_ROW) _
                    .Resize(sRowsCount).Columns(SRC_COLUMNS)
                dncell.Offset(dRowsCount).Value = swb.Name ' write workbook name
                drrg.Offset(dRowsCount).Resize(sRowsCount).Value = srg.Value
                dRowsCount = dRowsCount + sRowsCount
                swsCount = swsCount + 1
            'Else ' no data found
            End If
        'Else ' totals row not identified
        End If
        
        swb.Close SaveChanges:=False
        
        sFileName = Dir ' next file
    Loop
    
    Application.ScreenUpdating = True

    ' Inform.
    
    MsgBox "Retrieved " & dRowsCount & " row" _
        & IIf(dRowsCount = 1, "", "s") & " of data from " _
        & swsCount & " file" & IIf(swsCount = 1, "", "s") & ".", _
        vbInformation, PROC_TITLE

End Sub