0

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

Rich Joyce
  • 1
  • 3

4 Answers4

1

You can stop the flickering screen by setting the following: 

Application.ScreenUpdating = False

Add that to your macro and run it again.

Kier
  • 48
  • 6
0

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
Tim Edwards
  • 1,031
  • 1
  • 13
  • 34
  • Even iterate across an array/collection of workbook names. – Parfait Sep 06 '16 at 13:08
  • Indeed, though by the macro recording I didn't want to make it more complex than the OP could understand easily. – Tim Edwards Sep 06 '16 at 13:25
  • Thanks both - These are great comments. Tim - I will certainly implement these changes. Parfait - I am eager to learn - is there another topic that discusses your points I can study? – Rich Joyce Sep 07 '16 at 07:17
  • Tim - just a question - I understand and appreciate the logic for the copy and paste, but am struggling the False at the end of the workbooks.Close - would you explain the syntax of this so my simple brain can better understand! :-) – Rich Joyce Sep 07 '16 at 07:23
  • Not a problem. It means don't save when I'm closing. If it's left then on some occasions you may get asked if you want to save the workbook. It's all detailed [here](https://msdn.microsoft.com/en-us/library/office/ff838613.aspx). – Tim Edwards Sep 07 '16 at 07:58
  • In terms of arrays, it's a bit more complicated to get your head around but [this](http://www.excel-easy.com/vba/array.html) should explain. Go through the 5 pages and you should have enough knowledge to implement it. – Tim Edwards Sep 07 '16 at 08:06
  • I always encourage using the `With ... End With` statement. It is easy to learn and a good practice to get into. – Brian Sep 07 '16 at 10:07
  • Good point. I normally would with my own code but for some reason omitted here. I will edit. – Tim Edwards Sep 07 '16 at 10:08
0

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.

Community
  • 1
  • 1
Brian
  • 2,078
  • 1
  • 15
  • 28
  • Hi Brian, This is good advice - and it makes sense. How do I go about making my variable a particular worksheet in a workbook - can you point me in the right direction and then I will give it a go ans show you where I got to. Many thanks – Rich Joyce Sep 07 '16 at 11:04
  • One more thing, have you considered using formulas? You can pull data from closed workbooks with formulas. – Brian Sep 07 '16 at 12:11
  • Hi Brian, This is great! I will have a play with it and let you know how I get on. I have not tried using formulas to be fair - I wasn't sure how the data would update if I just use a formula. Maybe I have made a wrong assumption. Either way, I am learning about VBA which cannot be a bad thing! Thanks again! Rich – Rich Joyce Sep 07 '16 at 13:39
  • @RichJoyce Anytime! If my answer solved your problem or helped in any way would you mark as correct or up vote (or both)? Thanks! – Brian Sep 07 '16 at 14:23
  • Hi - we had a national holiday out here so I have only just got back to the computer to continue. Certainly I will mark you up (if it lets me with my low prestige score) Naturally as soon as I can I will do so. – Rich Joyce Sep 14 '16 at 11:46
  • I am getting an error when I try to run the code - It is at this part: With Workbooks("master").Sheets("Cumulative").Activate .Range("C2:G2").Value = wb2016_JAMAL.Sheets("Summary").Range("G2:J2").Value It is saying subscript out of range. I have searched on this site, but the answers I have seen so far are very specific to individual tasks and I don't fully understand the logic. – Rich Joyce Sep 14 '16 at 13:16
  • @RichJoyce Remove `.Activate` – Brian Sep 14 '16 at 13:39
  • @RichJoyce Think of a `With` statement as the continuation of a line. You cannot say `With Workbooks("master").Sheets("Cumulative").Activate.Range...`. – Brian Sep 14 '16 at 13:44
  • I removed the .Activate but am still getting the same issue. I am on Excel 2007 btw. When I debug, it highlights With Workbooks("master").Sheets("Cumulative") the next line is now .Range("C2:G2").Value = wb2016_JAMAL.Sheets("Summary").Range("G2:J2").Value – Rich Joyce Sep 15 '16 at 09:35
0

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