Combine specific worksheets and columns with modified generric code

MILK1123

New Member
Joined
Aug 10, 2011
Messages
15
I'd like to copy specfic worksheets and specific columns in those worksheets to a master worksheet.
For example: Columns B, C, P, BC, & BS from worksheets 2010, 2009, 2008 etc. I copied the generic code from msdn for copying multiple worksheets, but I don't know which lines or what to change in those lines to meet my needs. Help Please!

Sub CopyDataWithoutHeaders()
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 summary sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True
' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"
' Fill in the start row.
StartRow = 2
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
' Find the last row with data on the summary
' and source worksheets.
Last = LastRow(DestSh)
shLast = LastRow(sh)
' If source worksheet is not empty and if the last
' row >= StartRow, copy the range.
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 to see whether there are enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If
' This statement copies values and formats.
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 summary sheet.
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Hello

To understand the code - the first step - it helps to indent the code. You can and should also use code tags on the forum here:

Code:
Sub CopyDataWithoutHeaders()

    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 summary sheet if it exists.
    Application.DisplayAlerts = False
    
    On Error Resume Next
    ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    
    Application.DisplayAlerts = True
    
    ' Add a new summary worksheet.
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "RDBMergeSheet"
    ' Fill in the start row.
    StartRow = 2
    ' Loop through all worksheets and copy the data to the
    ' summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then
        
            ' Find the last row with data on the summary
            ' and source worksheets.
            Last = LastRow(DestSh)
            shLast = LastRow(sh)
            
            ' If source worksheet is not empty and if the last
            ' row >= StartRow, copy the range.
            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 to see whether there are enough rows in the summary
                ' worksheet to copy all the data.
                If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                    MsgBox "There are not enough rows in the summary worksheet to place the data."
                    GoTo ExitTheSub
                End If
                
                ' This statement copies values and formats.
                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 summary sheet.
    DestSh.Columns.AutoFit
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Where is the code of the function LastRow by Ron De Bruin? Without that it will not work.

After that, step through the macro using F8 and see what happens / or not. Make the Excel screen and VBA screen each half their size, so that you can see both at the same time.
 
Upvote 0
The code works, but it merges all 44 worksheets in the workbook. I only want to combine certain worksheets. i.e. years 2010 thru 2001. And I only want certain columns from those worksheets. i.e. Columns B,C,P,BS. Im a novice VB, so Im not exactly sure which lines in the code to change and what syntax to use to meet my needs. Any suggestions would be greatly appreciated.
 
Upvote 0

Forum statistics

Threads
1,224,587
Messages
6,179,735
Members
452,939
Latest member
WCrawford

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top