Macro to copy paste multiple worksheets data into one worksheets

su2009

Board Regular
Joined
Sep 24, 2010
Messages
81
hi,

i need a macro which copy and paste from multiple worksheets (except for 3 worksheets which is named after Jan, Feb and Mar) into one worksheets (named as OVERALL). The data to copy will cover from cell A1:D1 and below where there is data available. Thanks in advance.
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Maybe:

Code:
Sub su2009()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets

    If ws.Name <> "Jan" Then
    
        If ws.Name <> "Feb" Then
        
            If ws.Name <> "Mar" Then
            
                If ws.Name <> "OVERALL" Then
    
                    ws.Activate
        
                    ws.Range("A1:D1").Copy Sheets("OVERALL").Range("A" & Rows.Count).End(3)(2)
                    
                End If
                
            End If
            
        End If
        
    End If
    
Next ws

End Sub
 
Upvote 0
Would this give the same results as the nestedIfs you have in your code

Code:
If ws.Name <> "Jan" and ws.name<> "Feb" and ws.name<> "Mar"
 
Upvote 0
hi John,

The macro is not workin like it suppose to. it couldnt combine all the data of the worksheets in OVERALL. anyhow here is currently the macro that i am using but this macro is only copying specific worksheets (RAW to RAW6). anyway to go around this. i need the macro to copy all the worksheets except for worksheet "DateTime", "VLOOKUP", "RDBMergeSheet" and the data to combine in worksheet "RDBMergeSheet".

Sub CombineWorksheets()
Sheets("RDBMergeSheet").Select
Cells.Select
Selection.ClearContents
Sheets("RAW").Select
Range("C1:H1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("RDBMergeSheet").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
Sheets("RAW (2)").Select
Range("C1:H1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("RDBMergeSheet").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
Sheets("RAW (3)").Select
Range("C1:H1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("RDBMergeSheet").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
Sheets("RAW (4)").Select
Range("C1:H1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("RDBMergeSheet").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
Sheets("RAW (5)").Select
Range("C1:H1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("RDBMergeSheet").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
Sheets("RAW (6)").Select
Range("C1:H1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("RDBMergeSheet").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
End Sub
 
Upvote 0
The macro I provided was tested, and worked for me. What is it not doing that you want it too do? To adjust just change the names of the sheets in the code that are not to be copied, the destination sheet and the range.
 
Upvote 0

Forum statistics

Threads
1,213,558
Messages
6,114,296
Members
448,564
Latest member
ED38

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