• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 320
  • Last Modified:

Combining Sheet1 from multiple work books

I need some help and I am stuck.


Open at least 30 work books, and copy sheet 1. I need to copy from row 3 down to the last row which varies on each sheet. Then past it starting on Row 2 of a "master" sheet in the master file. And tack on each sheet to the end of the next one.

The files I am opening have several tabs on the bottom I need it to copy Sheet1 starting at Row3 (Row 1 and 2 are headers) Then take this data and the copy it to a new file starting on Row 2, then the next file at the bottom of this and so forth to combine them.

I am using the code below:

Option Explicit
Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim Lastrow As Long
Dim Firstrow1 As Long
Dim LastRow1 As Long
Dim Lrow1 As Long
Dim myRange As Range

Sub CompileUnpaidBalanceInThisFolder()
    Application.ScreenUpdating = False
    ChDrive ActiveWorkbook.path
    ChDir ActiveWorkbook.path
    ToBook = ActiveWorkbook.Name
    Set ToSheet = ActiveSheet
    NumColumns = ToSheet.Range("A1").End(xlToRight).Column
    ToRow = ToSheet.Range("A65536").End(xlUp).Row
    If ToRow <> 1 Then
        ToSheet.Range(ToSheet.Cells(2, 1), _
            ToSheet.Cells(ToRow, NumColumns)).ClearContents
    End If
    ToRow = 2
    '- main loop to open each file in folder
    FromBook = Dir("*.xls")
    While FromBook <> ""
        If FromBook <> ToBook Then
            Application.StatusBar = FromBook
            Transfer_data   ' subroutine below
        End If
        FromBook = Dir

Set myRange = Range("B2", Range("B65536").End(xlUp))
Application.ScreenUpdating = True
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
'Range("K11").Value = "This data was last"
'Range("K12").Value = "compiled on"
'Range("K13").Value = "=today()"
End Sub

Private Sub Transfer_data()
    Workbooks.Open Filename:=FromBook
       For Each FromSheet In Workbooks(FromBook).Worksheets
       'Set FromSheet = Workbooks(FromBook).Worksheets("Sheet1")
          Lastrow = FromSheet.Range("A65536").End(xlUp).Row
        '- copy/paste to master sheet
        FromSheet.Range(FromSheet.Cells(3, 1), _
        FromSheet.Cells(Lastrow, NumColumns)).Copy _
        Destination:=ToSheet.Range("A" & ToRow)
        '- set next ToRow
        ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
    Workbooks(FromBook).Close SaveChanges:=False
End Sub

This copies all the tabs for some reason, and doesn't start coping or pasting where I want it to.

The final "master" file will be copied to the directory for the month opened and then ran from that directory. The code I have is starting to work, but it copies all the tabs, and the loop never stops. Anyone have a clue how I can do this simple?

  • 2
1 Solution
Patrick MatthewsCommented:
dn920 said:
>>This copies all the tabs for some reason, and doesn't start coping or pasting where I want it to.

This line from Transfer_data is probably the culprit:

       For Each FromSheet In Workbooks(FromBook).Worksheets

You are enumerating the worksheets in that workbook, and there is no inner If structure to test for a worksheet
name or some other criterion for whether to use it or not.
dn920Author Commented:
I tried to activate the sheet "Sheet1" however when I do that it stops the code and throws the debugger up...  doesn't make sense why its doing that.
dn920Author Commented:
Never mind I am a dope you nailed it on the head thanks!!

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now