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
Not clear. :confused:
Please provide additional information.
Images are pretty much useless to help solve issues. Upload sample worksheets with enough data to allow analysis and determine a suitable solution.
Hello LalitPandey87,
I will upload the file shortly... thanks :)
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
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.
Quote:
Originally Posted by Admin
Thanks Admin... file has been attached
Hi
Try this.
Allow you to select the folder and the macro will do the rest for you !Code: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
Hello Admin... Thanks so much for the help... Your code works as awesomely cool.. thank you thank you thank you!! :)
You are welcome :cheers:Quote:
Originally Posted by jeremiah_j2k