Import row data from multiple worksheets to generate a report using vba

[jeremiah_j2k]

Hi All,

I would like to ask assistance in exporting data from several worksheets to create a summary report on a daily basis. Data are from xlsm files and they have a common name (Part of Backlog_Report_Generator_ver10 xlsm followed by date and time and .xlsm). The number of workbook where to import data varies also the number or rows to be imported depending on the number or people assigned to do the tasks. Below is the snippet of my file. Please help.

File snippet:
backlog_report.png

[LalitPandey87]

Not clear.
Please provide additional information.

[alansidman]

Images are pretty much useless to help solve issues. Upload sample worksheets with enough data to allow analysis and determine a suitable solution.

[jeremiah_j2k]

Hello LalitPandey87,

I will upload the file shortly... thanks

[jeremiah_j2k]

Hello alansidman,

Thanks for the advise. Below are the files that might help you determine a suitable solution. Thanks in advanced


Excel File:
BLver10-Test


File snippet:
backlog_report.png

[Admin]

Upload the file here in this forum. Click on Go Advanced button and you can upload the files. If it's too large, zip the file and upload.

[jeremiah_j2k]

Upload the file here in this forum. Click on Go Advanced button and you can upload the files. If it's too large, zip the file and upload.

Thanks Admin... file has been attached

[Admin]

Hi

Try this.

Option Explicit
Sub kTest()
    
    Dim Foldr       As String, FName       As String
    Dim WbkA        As Workbook, WbkT       As Workbook
    Dim Dest        As Range, StartCell   As String
    Dim r   As Long
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "Select the raw files folder..."
        If .Show = -1 Then
            Foldr = .SelectedItems(1)
        Else: Exit Sub
        End If
    End With
    Foldr = Foldr & Application.PathSeparator
    
    FName = Dir(Foldr & "*.xlsm")
    
    If Len(FName) = 0 Then Exit Sub
    
    Application.ScreenUpdating = 0
    
    Set WbkT = ThisWorkbook
    Set Dest = WbkT.Worksheets("Report").Range("C27")
    
    StartCell = "C8"        '<<< adjust
    
    If MsgBox("Do you want to overwrite the data?", vbQuestion + vbYesNo) = vbNo Then
        Set Dest = Dest.Parent.Cells(Dest.Parent.Rows.Count, Dest.Column).End(3)(2)
    Else
        Dest.Resize(Dest.CurrentRegion.Rows.Count, 8).ClearContents
    End If
    
    Do While Len(FName)
        If Not WbkT.Name = FName Then
            Set WbkA = Workbooks.Open(Foldr & FName, 0)
            With WbkA.Worksheets(1).Range(StartCell) 'data from the 1st sheet
                Debug.Print Dest.Address
                r = .CurrentRegion.Rows.Count - 1
                Dest.Resize(r, 8).Value = .Resize(r, 8).Value2
                Set Dest = Dest.Offset(r)
            End With
            WbkA.Close 0
            Set WbkA = Nothing
        End If
        FName = Dir()
    Loop
    Application.ScreenUpdating = 1
    MsgBox "Done!", vbInformation, "Excelfox.com"
    
End Sub

Allow you to select the folder and the macro will do the rest for you !

[jeremiah_j2k]

Hello Admin... Thanks so much for the help... Your code works as awesomely cool.. thank you thank you thank you!!

[Admin]

Hello Admin... Thanks so much for the help... Your code works as awesomely cool.. thank you thank you thank you!!

You are welcome