Click here to Skip to main content
15,868,141 members
Please Sign up or sign in to vote.
0.00/5 (No votes)
See more:
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
Posted
Updated 15-Jul-22 2:17am

1 solution

The error probably means that the Find failed, so Row will not be a valid item. You should check the return value before trying to select the Row. See the Remarks section of Range.Find method (Excel) | Microsoft Docs[^].
 
Share this answer
 
Comments
ShoRaj 18-Jul-22 14:08pm    
Thnak for the information

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900