Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

MS Excel VBA - Merge certain worksheets into one worksheet 1

Status
Not open for further replies.
BxWill

BxWill

MIS
Mar 30, 2009
367
US
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
 
Sort by date Sort by votes
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 [highlight #FCE94F]value[/highlight]...
Code: 
 'Fill in the start row
    StartRow = [highlight #FCE94F]2[/highlight]
...assuming that the heading row is always in row 1.

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote

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...
 
Upvote 0 Downvote
“pipe delimited file to be uploaded into a Sql Server Database using Bulk Insert.”

I understand your current approch. Thanks for the clarification.

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
Upon revising the code, No headers are displayed.

 
Upvote 0 Downvote
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?
 
Upvote 0 Downvote
Code: 
 'Fill in the start row
    [b]StartRow = 1[/b]
    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
            
‘......
       [b]StartRow = 2[/b]
    Next sh

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
Please post your code

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote

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
 
Upvote 0 Downvote
You did not do what I instructed you to do!
Code: 
    'Fill in the start row
    [b]StartRow = 1[/b]

    '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
        
        
        [b]StartRow = 2[/b]
    Next

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
Appreciate the time and insight, but it did not work.
 
Upvote 0 Downvote
Please explain how it did not work.

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
Set up a test in my Excel. 3 sheets, each with data in column A
[pre]
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
[/pre]
So row 1 on the 3 sheets respectively is 1, 11, 111.

Here are the results in Combined using the last code you posted...
[pre]
1
2
3
4
5
6
22
33
44
55
66
77
222
333
444
555
666
777
888
999
[/pre]
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,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
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.

 
Upvote 0 Downvote
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,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
Noted.

Any insight as to the modifications needed to ensure that all of the data is merged into the worksheet "combined?
 
Upvote 0 Downvote
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)?
Click to expand...

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,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
Can you upload your workbook?

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Solved
Combine two working macros into one for MS Word 1
Replies
7
Views
770
strongm
strongm
K
  • Locked
  • Question
How to resolve define worksheets array
Replies
1
Views
506
combo
combo
remeng
  • Locked
  • Question
Run PowerShell Commands from Excel VBA
Replies
14
Views
2K
dhookom
dhookom
thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
437
combo
combo
Andrzejek
  • Locked
  • Question
Outlook VBA - Trust access
Replies
3
Views
688
hermanlaksko
hermanlaksko

Part and Inventory Search

Sponsor

Back
Top