I have multiple workbooks in a Folder around 8 and there are Similar columns in some of these workbooks.
For Example:
There are 6 Workbooks out of 8 have similar column which Header name is "SouthRecord" i want to search that header in 1st row of each workbook if finds then copy that entire column from multiple workbooks availble in Folder and Paste appended result into an open workbook where from code is being run.
Code is coping tha data but getting error on this line LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Object variable and with block variable not set.
If 4 workbooks has Same Header then these 4 column will be pasted into open workbook as single column.
I would appreciate your help.
What I have tried:
Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim twb As Workbook
Dim LastRow As Long, colArr As Variant, order As Long, i As Long
Application.ScreenUpdating = FALSE
Application.EnableEvents = FALSE
Application.Calculation = xlCalculationManual
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
Set twb = ThisWorkbook
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = FALSE
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
myExtension = "*.xlsx*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
Set wb = Workbooks.Open(Filename:=myPath & myFile)
DoEvents
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = LBound(colArr) To UBound(colArr)
order = sht.Rows(1).Find("Company Name", LookIn:=xlValues, lookat:=xlWhole).Column
sht.Range(sht.Cells(2, order), sht.Cells(LastRow, order)).Copy twb.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Next i
wb.Close SaveChanges:=True
DoEvents
myFile = Dir
Loop
MsgBox "Task Complete!"
ResetSettings:
Application.EnableEvents = TRUE
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = TRUE
End Sub