×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

MS Excel VBA - Merge certain worksheets into one worksheet

MS Excel VBA - Merge certain worksheets into one worksheet

MS Excel VBA - Merge certain worksheets into one worksheet

(OP)
Have workbook with 25 worksheets. I need to merge all of the worksheets except two worksheets ("EquipmentTest" and "CapitalTest") to a single worksheet named "Combined."


Note, The 23 remaining worksheets have the same column headers, same number of columns.


For any given week, the number of worksheets to merge varies and there is no way to know the specific names of the worksheets to be merged. One week, there can
be 25, another week - there may be 40 and so on.


Using the code below will merge the data onto one worksheet but there are column headers from each worksheet that are dispersed throughout the data.
Note, a column header at the very top of the data and multiple column headers throughout!

There should only be one column header on the worksheet "combined."

Attempting to modify but not successful so far.

Any insight as to how to resolve?

One thought was to include another variable to designate that the first worksheet other than the worksheets ""EquipmentTest" and "CapitalTest."

Then, while the variable = 1, copy the header columns, increment to "2" and then copy the current region for the remaining worksheets without the column header. Currently working on this approach but thought that there may be a more efficient method.

Thanks in advance.

CODE

Sub CopyDataFromSelectWorksheets()

    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim shLast As Long
    Dim CopyRng As Range
    Dim StartRow As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Delete the sheet "Combined" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Combined").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "Combined"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Combined"

    
    
    'Fill in the start row
    StartRow = 1
    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
            

        If IsError(Application.Match(sh.Name, _
            Array(DestSh.Name, "EquipmentTest", "CapitalTest"), 0)) Then


            'Find the last row with data on the DestSh and sh
            Last = LastRow(DestSh)
            shLast = LastRow(sh)

            'If sh is not empty and if the last row >= StartRow copy the CopyRng
            If shLast > 0 And shLast >= StartRow Then

                'Set the range that you want to copy
                Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

                'Test if there enough rows in the DestSh to copy all the data
                If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                    MsgBox "There are not enough rows in the Destsh"
                    GoTo ExitTheSub
                End If

               
                CopyRng.Copy
                With DestSh.Cells(Last + 1, "A")
                    .PasteSpecial xlPasteValues
                    .PasteSpecial xlPasteFormats
                    Application.CutCopyMode = False
                End With

            End If

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub 

CODE

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function 

CODE

Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function 

RE: MS Excel VBA - Merge certain worksheets into one worksheet

Hi,

On these various sheets, all having the same headings in the same order and only one row of headings, does every table heading start in A1?

You seem to be combining the data into a new sheet, Combined, in the ActiveWorkbook. So by the end of the year you’ll have 52 workbooks or another way of stating the situation, similar data in 52 places. If it were me, I’d put ALL the data in ONE workbook/sheet with an additional column for a Week-Of date.

BTW, the answer to your question, change the StartRow value...

CODE

'Fill in the start row
    StartRow = 2 
...assuming that the heading row is always in row 1.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: MS Excel VBA - Merge certain worksheets into one worksheet

(OP)

All of the 23 worksheets to be merged have the same headings in the same order and only one row of headings and the headings start at cell A1.

Yes, the current process have some flaws but they are tolerable at this point. Vast improvement on what was done previously!

Just to provide additional context, I take the data from the numerous worksheets and combine them. Then, I add additional data before saving as a pipe delimited file to be uploaded into a Sql Server Database using Bulk Insert.

Finally, A query to Sql Server from MS Excel-based templates for presentation/charts, etc.

Note, the MS Excel workbook is just a template to consolidate the vast amounts of data prior to importing to Sql Server Db.

Use of Awk and/or Python or R may be more effective than the use of MS Excel in certain instances but the current approach appears reasonably effective...

RE: MS Excel VBA - Merge certain worksheets into one worksheet

“pipe delimited file to be uploaded into a Sql Server Database using Bulk Insert.”

I understand your current approch. Thanks for the clarification.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: MS Excel VBA - Merge certain worksheets into one worksheet

(OP)
Upon revising the code, No headers are displayed.

RE: MS Excel VBA - Merge certain worksheets into one worksheet

(OP)
No headers are displayed along the first row nor throughout the data.

What modifications are needed to display just one header at the top - along row 1?

RE: MS Excel VBA - Merge certain worksheets into one worksheet

CODE

'Fill in the start row
    StartRow = 1
    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
            
‘......
       StartRow = 2
    Next sh 

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: MS Excel VBA - Merge certain worksheets into one worksheet

(OP)
Headers are still dispersed within the data.

It appears that maybe after the first worksheet that is merged, I should use something like Used range and offset it by 1 row for all of the other worksheets that need to be merged.

RE: MS Excel VBA - Merge certain worksheets into one worksheet

Please post your code

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: MS Excel VBA - Merge certain worksheets into one worksheet

(OP)

Revised code is below.


CODE

Sub CopyDataFromSelectWorksheets()
Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim shLast As Long
    Dim CopyRng As Range
    Dim StartRow As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Delete the sheet "Combined" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Combined").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "Combined"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Combined"

    'Fill in the start row
    StartRow = 2
           
    'StartRow = 1

    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
      
        If IsError(Application.Match(sh.Name, _
            Array(DestSh.Name, "EquipmentTest", "CapitalTest"), 0)) Then

            'Find the last row with data on the DestSh
            Last = LastRow(DestSh)

            
            Set CopyRng = sh.Range("A1").CurrentRegion

            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If

            
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With


        End If
        
        If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
        sh.Range("A1:BA1").Copy DestSh.Range("A1")
        End If
        
        
        
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub 

RE: MS Excel VBA - Merge certain worksheets into one worksheet

You did not do what I instructed you to do!

CODE

'Fill in the start row
    StartRow = 1

    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
      
        If IsError(Application.Match(sh.Name, _
            Array(DestSh.Name, "EquipmentTest", "CapitalTest"), 0)) Then

            'Find the last row with data on the DestSh
            Last = LastRow(DestSh)

            
            Set CopyRng = sh.Range("A1").CurrentRegion

            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If

            
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With


        End If
        
        If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
        sh.Range("A1:BA1").Copy DestSh.Range("A1")
        End If
        
        
        StartRow = 2
    Next 

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: MS Excel VBA - Merge certain worksheets into one worksheet

(OP)
Appreciate the time and insight, but it did not work.

RE: MS Excel VBA - Merge certain worksheets into one worksheet

Please explain how it did not work.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: MS Excel VBA - Merge certain worksheets into one worksheet

(OP)
Stand corrected!

When I delete some of the worksheets that I want to merge and then delete all of the records except three or four in the remaining worksheets that I want to merge, the code works.

Then, going back and re-importing all of the worksheets that I want to merge into the workbook, re-running the code, then all of the data is imported to the "Combined" worksheet but there are no column headers at the top - along row 1.

Appreciate any further insight as to a resolution.

Using this

CODE

Sub CopyDataFromSelectWorksheets()

    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim shLast As Long
    Dim CopyRng As Range
    Dim StartRow As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Delete the sheet "Combined" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Combined").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "Combined"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Combined"

    
    
    'Fill in the start row
'Fill in the start row
    StartRow = 1

    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
      
        If IsError(Application.Match(sh.Name, _
            Array(DestSh.Name, "EquipmentTest", "CapitalTest"), 0)) Then
'replace
            'Find the last row with data on the DestSh
            'Last = LastRow(DestSh)

            
            'Set CopyRng = sh.Range("A1").CurrentRegion
'replace


 'Find the last row with data on the DestSh and sh
            Last = LastRow(DestSh)
            shLast = LastRow(sh)

            'If sh is not empty and if the last row >= StartRow copy the CopyRng
            If shLast > 0 And shLast >= StartRow Then

                'Set the range that you want to copy
                Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
            End If ' added this line



            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If

            
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With


        End If
        
        'If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
        'sh.Range("A1:BA1").Copy DestSh.Range("A1")
        'End If
        
        
        StartRow = 2
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub 

RE: MS Excel VBA - Merge certain worksheets into one worksheet

Set up a test in my Excel. 3 sheets, each with data in column A
Sheet1	Sheet2	Sheet3
1	11	111
2	22	222
3	33	333
4	44	444
5	55	555
6	66	666
	77	777
		888
		999
 
So row 1 on the 3 sheets respectively is 1, 11, 111.

Here are the results in Combined using the last code you posted...
1
2
3
4
5
6
22
33
44
55
66
77
222
333
444
555
666
777
888
999
 
NOTICE: I have 1, but not 11 or 111.

Seems to me that's what you're looking for unless I'm misunderstanding something.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: MS Excel VBA - Merge certain worksheets into one worksheet

(OP)
Great catch!

Is incrementing the variable, "StartRow = 2", resulting in the exclusion of the first row under the header for each of the worksheets to be merged (other than the first merged worksheet)?

I am interested in combining all of the records from the worksheets that should be merged.

The column header from the first worksheet that should be merged and all of the records.

RE: MS Excel VBA - Merge certain worksheets into one worksheet

StartRow is never incremented. It starts as 1 and is 2 thereafter.

???

My test demonstrates that your code gets row 1 on the first pass of the loop and omits row 1 thereafter.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: MS Excel VBA - Merge certain worksheets into one worksheet

(OP)
Noted.

Any insight as to the modifications needed to ensure that all of the data is merged into the worksheet "combined?"

RE: MS Excel VBA - Merge certain worksheets into one worksheet

Quote:

Is incrementing the variable, "StartRow = 2", resulting in the exclusion of the first row under the header for each of the worksheets to be merged (other than the first merged worksheet)?

That does not make sense with the code you supplied!

I ran your code without modification in my test workbook and row 2 data (2, 22, 222) from all sheets appears in the Combine sheet.

So your woakbook has some other sheet data configuration that you’re not revealing!

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: MS Excel VBA - Merge certain worksheets into one worksheet

Can you upload your workbook?

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: MS Excel VBA - Merge certain worksheets into one worksheet

(OP)
Well,

Quite interesting observation is that if there is a query table on one of the worksheets, then the code does not work.

When I change the table to a normal range, the code works.

The query table will occur later in the process, after the data is merged into the "combined" worksheet.

The worksheet with the query table is sourced from another worksheet. This is the worksheet that I had planned to either download as a pipe delimited file to be bulk inserted into a Sql Server table or create a linked server.

Any insight as to the use of a linked server to load the Sql Server table relative to the use of bulk insert. (Currently, I am favoring the bulk insert process)

May need to start another thread...

RE: MS Excel VBA - Merge certain worksheets into one worksheet

Quote:

Quite interesting observation is that if there is a query table on one of the worksheets, then the code does not work.

That ABSOLUTELY makes no sense.

Plz upload your workbook, query table and all. There must be something else going on.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: MS Excel VBA - Merge certain worksheets into one worksheet

(OP)
Not able to upload workbook due to confidentiality of the data and other code within.

Does not make sense to me but the code works after the table is converted.

RE: MS Excel VBA - Merge certain worksheets into one worksheet

I just added a QT to my test workbook. Runs like a top!

I see no relationship between QTs and your code not running properly.

If you could pare down and sanitize your workbook to the point where 1) the malfunction occurs and 2) it can be viewed without compromising your business, please upload that version.

But if you are saying that making the QTs normal tables "fixes" things, then just do that.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close