CODEWITHSUNDEEP
excelvba
Manz
Manz

Reputation: 605

Loop through each Specific files in a folder

I have been trying to iterate over each Excel (XLSX)files containing special character in a folder and copy the data from each file and Append to another file just below The last available row in Another File.

Input Folder Structure:

JCB_Infra Pvt Ltd.xlsx
Indiana_Jesx_Infra Pvt Ltd.xlsx
Nvidia_Softwares Ltd.Xlsb
NGX-India_Infra Pvt Ltd.xlsx
Solatire_Infrastructure Pvt Ltd.xlsx
ADX_Infra pvt ltd.csv

We only have to iterate over the files with .xlsx extension and Containing "Infra Pvt Ltd", And Append all the Data available without headers to another File.

Code I have been Using:

Sub Append_Files():
Dim xWb As Workbook
Dim Sheet1 As Worksheet
Dim File_path As Variant

stat_val = "Infra Pvt Ltd"
File_path  = Dir("C:\Users\XYZ\Documents\MixedFiles\") 
While File_path <> ""
     set xWB = Workbooks.Open(File_path & "*.xlsx"
     MsgBox xWB

Need Help:

Upvotes: 0

Views: 46

Answers (1)

Elie Asmar
Elie Asmar

Reputation: 3165

Sub Append_Files()
    Dim xWb As Workbook
    Dim Sheet1 As Worksheet
    Dim File_path As Variant
    Dim stat_val As String
    
    stat_val = "Infra Pvt Ltd"
    File_path = Dir("C:\Users\XYZ\Documents\MixedFiles\*.xlsx")
    
    While File_path <> ""
        If InStr(File_path, stat_val) Then
            Set xWb = Workbooks.Open(File_path)
            Set Sheet1 = xWb.Sheets(1)
            ' Append data from Sheet1 to another workbook below the last used row
            '...
        End If
        File_path = Dir
    Wend
    ' Copy data from Sheet1 and paste it to the last used row of the destination workbook
    Sheet1.Range("A1:D10").Copy
    DestinationWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues

End Sub

Upvotes: 1

Related Questions