Loop through multiple files in folder and copy/paste to master file

Question

I need to copy from multiple files in a specific folder and paste into a Master file. All files have a sheet called "Analysis", variable rows, but constant columns. I need to copy from all files the sheet "Analysis" A4:AB and paste in workbook called "Evaluations" in Sheet called "Evaluations" G2:AH, one below the other. I have the below code, which worked but doesn't anymore and I don't know why. Can you please help?

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim lastRow As Long
    Const strPath As String = "V:\Trade Marketing\Trade Finance\2021\Projects\Evaluation\Analysis\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
                    lastRow = .Sheets("Analysis").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("Analysis").Range("A4:AB" & lastRow).Copy wkbDest.Sheets("Evaluations").Cells(Rows.Count, "G").End(xlUp).Offset(1, 0)
            .Close SaveChanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Answer 1

Backup Data Columns

Option Explicit

Sub AnalysisBackup()
    
    Const swbPath As String _
        = "V:\Trade Marketing\Trade Finance\2021\Projects\Evaluation\Analysis\"
    Const swbPattern As String = "*.xls*"
    
    Const sName As String = "Analysis"
    Const sCols As String = "A:AB"
    Const sFirstRow As Long = 4
    
    Const dName As String = "Evaluations"
    Const dFirst As String = "G2"
    
    Dim swbName As String: swbName = Dir(swbPath & swbPattern)
    If swbName = "" Then Exit Sub ' no file found
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
    Dim cCount As Long: cCount = dws.Columns(sCols).Columns.Count
    Dim dirrg As Range: Set dirrg = dws.Range(dFirst).Resize(, cCount)
    Dim drrg As Range ' Destination First Row Range
    Dim dlCell As Range ' Destination Last Cell
    Set dlCell = dirrg.Resize(dws.Rows.Count - dirrg.Row + 1) _
        .Find("*", , xlFormulas, , xlByRows, xlPrevious)
    If dlCell Is Nothing Then
        Set drrg = dirrg
    Else
        Set drrg = dirrg.Offset(dlCell.Row - dirrg.Row + 1)
    End If
            
    Dim swb As Workbook ' Source Workbook
    Dim sws As Worksheet ' Source Worksheet
    Dim srg As Range ' Source Range
    Dim slCell As Range ' Source Last Cell
    Dim srCount As Long ' Source Range Rows Count
    
    Dim drg As Range ' Destination Range
    
    Application.ScreenUpdating = False
    
    Do While swbName <> ""
        Set swb = Workbooks.Open(swbPath & swbName)
        Set sws = Nothing
        On Error Resume Next
        Set sws = swb.Worksheets(sName)
        On Error GoTo 0
        If Not sws Is Nothing Then
            Set slCell = Nothing
            With sws.Rows(sFirstRow).Columns(sCols)
                Set slCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
                    .Find("*", , xlFormulas, , xlByRows, xlPrevious)
                If Not slCell Is Nothing Then
                    srCount = slCell.Row - .Row + 1
                    Set srg = .Resize(srCount)
                    Set drg = drrg.Resize(srCount)
                    drg.Value = srg.Value
                    Set drrg = drrg.Offset(srCount)
                'Else ' empty source range
                End If
            End With
        'Else ' source worksheet does not exist
        End If
        swb.Close SaveChanges:=False
        swbName = Dir
    Loop
    
    'dwb.Save
    
    Application.ScreenUpdating = True
    
    MsgBox "Analysis backup created.", vbInformation, "Analysis Backup"
    
End Sub