PDA

View Full Version : Copying Multiple worksheets in Multiple workbooks to one single workbook



ebrabender
10-27-2011, 08:24 AM
I am having some problems trying to get this to work. It appears to be working partially but not fully and I am at a loss right now and would appreciate any help you could give me. I am trying to open up several files within one folder. There are 3 files per day that are saved into the folder. The folder corelates to the month. So for September I have 65 different files I want to open up. I only want to copy the information from A7:A20, C7:C20, and D7: D20. All fields may not be completely filled in all the time and may be left blank. I then want to have it take this information and put it on the workbook in which I am running the code. Here is the code I have so far. Does anyone have any suggestions or help that they could give me.

Sub Basic_Example_1()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
'Fill in the path\folder where the files are
MyPath = "Y:\Corrugator\SHIFT DOWNTTIME REPORT\9----Sept"
'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Add a new workbook with one sheet
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1
'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then
On Error Resume Next
With mybook.Worksheets(1)
Set sourceRange = .Range("A7:d7")
End With
If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
'if SourceRange use all columns then skip this file
If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
Set sourceRange = Nothing
End If
End If
On Error GoTo 0
If Not sourceRange Is Nothing Then
SourceRcount = sourceRange.Rows.Count
If rnum + SourceRcount >= BaseWks.Rows.Count Then
MsgBox "Sorry there are not enough rows in the sheet"
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else
'Copy the file name in column A
With sourceRange
BaseWks.Cells(rnum, "A"). _
Resize(.Rows.Count).Value = MyFiles(Fnum)
End With
'Set the destrange
Set destrange = BaseWks.Range("B" & rnum)
'we copy the values from the sourceRange to the destrange
With sourceRange
Set destrange = destrange. _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
rnum = rnum + SourceRcount
End If
End If
mybook.Close savechanges:=False
End If
Next Fnum
BaseWks.Columns.AutoFit
End If
ExitTheSub:
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub

Here is a screen shot of where I am pulling the information from as well:

http://i238.photobucket.com/albums/ff120/ebrabender/ShiftReportScreenShot.jpg
Thank you in advance,
Eric

ebrabender
10-27-2011, 12:35 PM
I seem to be close with the above code. However, I am noticing that it isn't pulling all of the data from all of the files within the folder in which they are and am not sure as to why. I notice that when the program itself is running it isn't pulling the files in order from start to finish that is it bouncing around a bit.

ebrabender
10-27-2011, 01:59 PM
I just confirmed it isn't pulling the files in order from how they are in the folder. Does anyone have any idea as of why? also it didn't pull any information from the very last file that it opened up. It pulled the file fields but not the data that was in the fields. The files are dates from the beginning of the month to the end. I would have assumed it would pull them in order from the first file in the folder till the last. However this is not what is happening.

ebrabender
10-28-2011, 08:25 AM
Alright I have it all figured out except for one thing. Instead of copying all the data I am pulling into a new workbook I want to open it up in the one I have the macro running in. Does this make sense? Any help would be great.

GTO
10-29-2011, 09:20 AM
Can you zip your workbook with the macro in it and a couple of the source wb's and attach the zip? PLease remove/substitute for any sensitive data and SaveAs in .xls format (at home where I cannot read .xlsm/.xlsx/etc)