Fix Subscript out of range VBA - excel

Question

I am try to copy formula and header contained in range "T12:W13" and paste it in the same cell location in all files in a folder. Cop to destination "T12:W13" then drag the formula all the way down close and save the sheet and then open next sheet till all the files in the folder are done.
Sub CopyRange()
Application.ScreenUpdating = False
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Const strPath As String = "C:\Users\kaii\Downloads\Jan 2022\"
ChDir strPath
strExtension = Dir("*.xlsx*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath & strExtension)
With wkbSource
.Sheets("Monthly").Range("T12:W13").Copy wkbDest.Sheets("XXTOLL_Collector_Invoice_*").Range("T12").Paste
ActiveCell.AutoFill Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
.Close savechanges:=False
End With
strExtension = Dir
Loop
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

Answer 1

Copy Columns (Headers, Formulas, Last Row) to Worksheets
Option Explicit
Sub CopyColumns()
' Source ('ThisWorkook')
Const sName As String = "Monthly"
Const sAddress As String = "T12:W13"
' Destination (Opening Workbooks)
Const dFolderPath As String = "C:\Users\kaii\Downloads\Jan 2022\"
Const dFileExtension As String = ".xlsx"
Const dFilePattern As String = "*"
Const dNameLeft As String = "XXTOLL_Collector_Invoice_"
Const dAddress As String = "T12:W13"
Dim dFileName As String
dFileName = Dir(dFolderPath & dFilePattern & dFileExtension)
If Len(dFileName) = 0 Then
MsgBox "No files found.", vbExclamation
Exit Sub
End If
Dim swb As Workbook: Set swb = ThisWorkbook
Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
Dim srg As Range: Set srg = sws.Range(sAddress)
Application.ScreenUpdating = False
Dim dwb As Workbook
Dim dws As Worksheet
Dim drg As Range
Dim dlrCell As Range
Do While Len(dFileName) > 0
Set dwb = Workbooks.Open(dFolderPath & dFileName)
For Each dws In dwb.Worksheets
If InStr(1, dws.Name, dNameLeft, vbTextCompare) = 1 Then ' begins w
Set drg = dws.Range(dAddress)
srg.Copy drg
Set dlrCell = dws.UsedRange _
.Find("*", , xlFormulas, , xlByRows, xlPrevious)
With drg.Resize(1).Offset(1)
.Resize(dlrCell.Row - .Row + 1).Formula = .Formula
End With
End If
Next dws
dwb.Close SaveChanges:=True
dFileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Columns copied.", vbInformation
End Sub