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

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