Log in

View Full Version : Import row data from multiple worksheets to generate a report using vba



jeremiah_j2k
11-11-2014, 05:41 PM
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 (http://postimg.org/image/6jo4b8dnd/)

LalitPandey87
11-14-2014, 11:31 AM
Not clear. :confused:
Please provide additional information.

alansidman
11-16-2014, 03:41 AM
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
11-17-2014, 12:04 PM
Hello LalitPandey87,

I will upload the file shortly... thanks :)

jeremiah_j2k
11-17-2014, 12:12 PM
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 (http://s000.tinyupload.com/download.php?file_id=03589292206083363758&t=0358929220608336375801653)


File snippet:
backlog_report.png (http://postimg.org/image/6jo4b8dnd/)

Admin
11-20-2014, 08:02 AM
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
11-20-2014, 09:32 AM
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
11-20-2014, 10:47 AM
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
11-24-2014, 09:48 AM
Hello Admin... Thanks so much for the help... Your code works as awesomely cool.. thank you thank you thank you!! :)

Admin
11-24-2014, 12:18 PM
Hello Admin... Thanks so much for the help... Your code works as awesomely cool.. thank you thank you thank you!! :)

You are welcome :cheers: