Merging data from different excel workbooks - excel

Question

Firstly I am a newbie when it comes to coding, but am giving it a go to see how it can help me dig down into my data.
I am currently looking at capturing time-sheet data for different team members and copying it into a master summary workbook.
I recorded my macro and then re-organised things a bit to make the code cleaner (this may be where I went wrong). But now when I run my macro I get a Run-time error '9': Subscript out of range.
my code is as follows:
Option Explicit
Sub MergeAll()
' Open all Timesheets
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_JAMAL.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_LOKESH.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_NONI.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_RAJESH.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_SANTHOSH.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_7.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_8.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_9.xlsx"
' Activate and Copy Data
Windows("2016_JAMAL.xlsx").Activate
Range("G2:J2").Select
Selection.Copy
Windows("master.xlsm").Activate
Range("C2:F2").Select
ActiveSheet.Paste
Windows("2016_LOKESH.xlsx").Activate
Range("G2:J2").Select
Selection.Copy
Windows("master.xlsm").Activate
Range("C2:F2").Select
ActiveSheet.Paste
Windows("2016_NONI.xlsx").Activate
Range("G2:J2").Select
Selection.Copy
Windows("master.xlsm").Activate
Range("C2:F2").Select
ActiveSheet.Paste
Windows("2016_RAJESH.xlsx").Activate
Range("G2:J2").Select
Selection.Copy
Windows("master.xlsm").Activate
Range("C2:F2").Select
ActiveSheet.Paste
Windows("2016_SANTHOSH.xlsx").Activate
Range("G2:J2").Select
Selection.Copy
Windows("master.xlsm").Activate
Range("C2:F2").Select
ActiveSheet.Paste
Windows("2016_WARREN.xlsx").Activate
Range("G2:J2").Select
Selection.Copy
Windows("master.xlsm").Activate
Range("C2:F2").Select
ActiveSheet.Paste
Windows("2016_7.xlsx").Activate
Range("G2:J2").Select
Selection.Copy
Windows("master.xlsm").Activate
Range("C2:F2").Select
ActiveSheet.Paste
Windows("2016_8.xlsx").Activate
Range("G2:J2").Select
Selection.Copy
Windows("master.xlsm").Activate
Range("C2:F2").Select
ActiveSheet.Paste
Windows("2016_9.xlsx").Activate
Range("G2:J2").Select
Selection.Copy
Windows("master.xlsm").Activate
Range("C2:F2").Select
ActiveSheet.Paste
' Close all Timesheets
Windows("2016_JAMAL.xlsx").Activate
ActiveWindow.Close
Windows("2016_LOKESH.xlsx").Activate
ActiveWindow.Close
Windows("2016_NONI.xlsx").Activate
ActiveWindow.Close
Windows("2016_RAJESH.xlsx").Activate
ActiveWindow.Close
Windows("2016_SANTHOSH.xlsx").Activate
ActiveWindow.Close
Windows("2016_WARREN.xlsx").Activate
ActiveWindow.Close
Windows("2016_7.xlsx").Activate
ActiveWindow.Close
Windows("2016_8.xlsx").Activate
ActiveWindow.Close
Windows("2016_9.xlsx").Activate
ActiveWindow.Close
End Sub
Now I took out some code which was appearing in each line, after the Windows("filename").Activate line. This was:
ActiveWindow.SmallScroll Down:=-18
As I believe that this was only when I scrolled up to the correct place and depending on which was the active cell prior to saving each time, this would change.
I am out of ideas and any help would be much appreciated.
For the record, I have so far tried several different methods - including copying and pasting code from sites, following you tube tutorial videos, but each time and each method, the same error occurs.
Thanks in advance,
Rich
UPDATE
I re-recorded the macro and simply changed the order of what I did during the record. I no longer get the error. However the code is very messy and long winded. The screen flickers a lot during the process too. is there a way to make it a smoother experience for the user? The new code is below
Sub MergeAll2()
'
' MergeAll2 Macro
'
'
' Open All
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_7.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_8.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_9.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_JAMAL.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_LOKESH.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_NONI.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_RAJESH.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_SANTHOSH.xlsx"
Workbooks.Open Filename:= _
"S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_WARREN.xlsx"
' Copy & Paste
Windows("2016_JAMAL.xlsx").Activate
Range("G2:J2").Select
Selection.Copy
Windows("master.xlsm").Activate
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("2016_LOKESH.xlsx").Activate
Range("G2:J2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("master.xlsm").Activate
Range("C3:F3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("2016_NONI.xlsx").Activate
Range("G2:J2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("master.xlsm").Activate
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("2016_RAJESH.xlsx").Activate
Range("G2:J2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("master.xlsm").Activate
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("2016_SANTHOSH.xlsx").Activate
Range("G2:J2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("master.xlsm").Activate
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("2016_WARREN.xlsx").Activate
Range("G2:J2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("master.xlsm").Activate
Range("C7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("2016_7.xlsx").Activate
Range("G2:J2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("master.xlsm").Activate
Range("C8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("2016_8.xlsx").Activate
Range("G2:J2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("master.xlsm").Activate
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("2016_9.xlsx").Activate
Range("G2:J2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("master.xlsm").Activate
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Close All
Windows("2016_JAMAL.xlsx").Activate
ActiveWindow.Close
Windows("2016_LOKESH.xlsx").Activate
ActiveWindow.Close
Windows("2016_NONI.xlsx").Activate
ActiveWindow.Close
Windows("2016_RAJESH.xlsx").Activate
ActiveWindow.Close
Windows("2016_SANTHOSH.xlsx").Activate
ActiveWindow.Close
Windows("2016_WARREN.xlsx").Activate
ActiveWindow.Close
Windows("2016_7.xlsx").Activate
ActiveWindow.Close
Windows("2016_8.xlsx").Activate
ActiveWindow.Close
Windows("2016_9.xlsx").Activate
ActiveWindow.Close
End Sub
UPDATE 2
Many thanks for the help so far. I am looking to edit this line:
Workbooks("master").ActiveSheet.Range("C2:F2").Value = Workbooks("2016_JAMAL").ActiveSheet.Range("G2:J2").Value
So that I can choose which sheet in "master" to write it to and also which sheet in "2016_JAMAL" to copy it from.
Secondly, I want to copy from two ranges on this sheet - C2:G2 and C5:G56
I would like to do this in a streamlined way.
Many thanks for your answers so far - I will read the information on Arrays and work through the 5 pages!
Rich

Answer 1

You can stop the flickering screen by setting the following:
Application.ScreenUpdating = False
Add that to your macro and run it again.

Answer 2

You should be able to speed up your "Copy & Paste" section by using this instead:
With Workbooks("master").ActiveSheet
.Range("C2:F2").Value = Workbooks("2016_JAMAL").ActiveSheet.Range("G2:J2").Value
.Range("C3:F3").Value = Workbooks("2016_LOKESH").ActiveSheet.Range("G2:J2").Value
.Range("C4:F4").Value = Workbooks("2016_NONI").ActiveSheet.Range("G2:J2").Value
.Range("C5:F5").Value = Workbooks("2016_RAJESH").ActiveSheet.Range("G2:J2").Value
.Range("C6:F6").Value = Workbooks("2016_SANTHOSH").ActiveSheet.Range("G2:J2").Value
.Range("C7:F7").Value = Workbooks("2016_WARREN").ActiveSheet.Range("G2:J2").Value
.Range("C8:F8").Value = Workbooks("2016_7").ActiveSheet.Range("G2:J2").Value
.Range("C9:F9").Value = Workbooks("2016_8").ActiveSheet.Range("G2:J2").Value
.Range("C10:F10").Value = Workbooks("2016_9").ActiveSheet.Range("G2:J2").Value
End With
You could also make your "close" part simpler by using:
Workbooks("2016_JAMAL.xlsx").Close False
Workbooks("2016_LOKESH.xlsx").Close False
Workbooks("2016_NONI.xlsx").Close False
Workbooks("2016_RAJESH.xlsx").Close False
Workbooks("2016_SANTHOSH.xlsx").Close False
Workbooks("2016_WARREN.xlsx").Close False
Workbooks("2016_7.xlsx").Close False
Workbooks("2016_8.xlsx").Close False
Workbooks("2016_9.xlsx").Close False

Answer 3

I used Activesheet not knowing how many sheets each workbook has or their names. You can adjust accordingly. Here's my version:
Option Explicit
Sub MergeAll2()
Dim wb2016_7 As Workbook
Dim wb2016_8 As Workbook
Dim wb2016_9 As Workbook
Dim wb2016_JAMAL As Workbook
Dim wb2016_LOKESH As Workbook
Dim wb2016_NONI As Workbook
Dim wb2016_RAJESH As Workbook
Dim wb2016_SANTHOSH As Workbook
Dim wb2016_WARREN As Workbook
Dim strPath As String
Application.ScreenUpdating = False
strPath = "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\"
Set wb2016_7 = Workbooks.Open(Filename:=strPath & "2016_7.xlsx")
Set wb2016_8 = Workbooks.Open(Filename:=strPath & "2016_8.xlsx")
Set wb2016_9 = Workbooks.Open(Filename:=strPath & "2016_9.xlsx")
Set wb2016_JAMAL = Workbooks.Open(Filename:=strPath & "2016_JAMAL.xlsx")
Set wb2016_LOKESH = Workbooks.Open(Filename:=strPath & "2016_LOKESH.xlsx")
Set wb2016_NONI = Workbooks.Open(Filename:=strPath & "2016_NONI.xlsx")
Set wb2016_RAJESH = Workbooks.Open(Filename:=strPath & "2016_RAJESH.xlsx")
Set wb2016_SANTHOSH = Workbooks.Open(Filename:=strPath & "2016_SANTHOSH.xlsx")
Set wb2016_WARREN = Workbooks.Open(Filename:=strPath & "2016_WARREN.xlsx")
With Workbooks("master").ActiveSheet
.Range("C2:F2").Value = wb2016_JAMAL.ActiveSheet.Range("G2:J2").Value
.Range("C3:F3").Value = wb2016_LOKESH.ActiveSheet.Range("G2:J2").Value
.Range("C4:F4").Value = wb2016_NONI.ActiveSheet.Range("G2:J2").Value
.Range("C5:F5").Value = wb2016_RAJESH.ActiveSheet.Range("G2:J2").Value
.Range("C6:F6").Value = wb2016_SANTHOSH.ActiveSheet.Range("G2:J2").Value
.Range("C7:F7").Value = wb2016_WARREN.ActiveSheet.Range("G2:J2").Value
.Range("C8:F8").Value = wb2016_7.ActiveSheet.Range("G2:J2").Value
.Range("C9:F9").Value = wb2016_8.ActiveSheet.Range("G2:J2").Value
.Range("C10:F10").Value = wb2016_9.ActiveSheet.Range("G2:J2").Value
End With
wb2016_7.Close True
wb2016_8.Close True
wb2016_9.Close True
wb2016_JAMAL.Close True
wb2016_LOKESH.Close True
wb2016_NONI.Close True
wb2016_RAJESH.Close True
wb2016_SANTHOSH.Close True
wb2016_WARREN.Close True
Set wb2016_7 = Nothing
Set wb2016_8 = Nothing
Set wb2016_9 = Nothing
Set wb2016_JAMAL = Nothing
Set wb2016_LOKESH = Nothing
Set wb2016_NONI = Nothing
Set wb2016_RAJESH = Nothing
Set wb2016_SANTHOSH = Nothing
Set wb2016_WARREN = Nothing
Application.ScreenUpdating = True
End Sub
It's good practice to use Option Explicit which forces you to declare your variables and to set your objects back to Nothing after using them.
EDIT
I would replace Activesheet with Sheets("SheetName") for each of the workbooks. Otherwise you could put the following code in the workbook object for every workbook (and save them all as macro enabled), except master, and keep Activesheet:
Private Sub Workbook_Open( )
Sheets ("SheetName").Activate
End Sub
I would, at least, change Workbooks("master").ActiveSheet to Workbooks("master").Sheets("SheetName") or you'll need to remember to run it from the correct (that is, active) sheet. This is a very helpful link, also.

Answer 4

This will merge a range from all workbooks in a folder (next data set goes below prior).
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 = "C:\Users\Ron\test"
'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("A1:C1")
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
This will merge a range from all workbooks in a folder (next data set goes to the right of prior).
Sub Basic_Example_3()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceCcount As Long, Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim Cnum As Long, CalcMode As Long
'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"
'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)
Cnum = 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
Set sourceRange = mybook.Worksheets(1).Range("A1:A10")
If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
'if SourceRange use all rows then skip this file
If sourceRange.Rows.Count >= BaseWks.Rows.Count Then
Set sourceRange = Nothing
End If
End If
On Error GoTo 0
If Not sourceRange Is Nothing Then
SourceCcount = sourceRange.Columns.Count
If Cnum + SourceCcount >= BaseWks.Columns.Count Then
MsgBox "Sorry there are not enough columns in the sheet"
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else
'Copy the file name in the first row
With sourceRange
BaseWks.cells(1, Cnum). _
Resize(, .Columns.Count).Value = MyFiles(Fnum)
End With
'Set the destrange
Set destrange = BaseWks.cells(2, Cnum)
'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
Cnum = Cnum + SourceCcount
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