Copy data from multiple worksheets to one sheet

kaydee1

New Member
Joined
Jan 17, 2019
Messages
2
hi guys, I am new to VBA and I need help copying data from multiple worksheets to a single sheet in the same workbook.
my workbook has 12 worksheets named by their moths. each worksheet has a number of rows that gets updated. please note that some fields of "Importer" are blank. for each worksheet I need to copy all mass values less than 20 and paste them to a new sheet called "under20", and transfer the rest to "over20".

your help will be much appreciated

worksheet 1 : 2017-04
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Importer[/TD]
[TD]Month[/TD]
[TD]Origin[/TD]
[TD]Mass[/TD]
[TD]Price[/TD]
[/TR]
[TR]
[TD]Importer 1[/TD]
[TD]April-17[/TD]
[TD]MZ[/TD]
[TD]100[/TD]
[TD]90[/TD]
[/TR]
[TR]
[TD]Importer 2[/TD]
[TD]April-17[/TD]
[TD]ZM[/TD]
[TD]50[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]Importer 3[/TD]
[TD]April-17[/TD]
[TD]IN[/TD]
[TD]20[/TD]
[TD]19[/TD]
[/TR]
[TR]
[TD]Importer 1[/TD]
[TD]April-17[/TD]
[TD]MZ[/TD]
[TD]200[/TD]
[TD]150[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]April-17[/TD]
[TD]GB[/TD]
[TD]20[/TD]
[TD]18[/TD]
[/TR]
</tbody>[/TABLE]










worksheet 12 : 2018-03
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Importer[/TD]
[TD]Month[/TD]
[TD]Origin[/TD]
[TD]Mass[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]Importer 1[/TD]
[TD]March -17[/TD]
[TD]MZ[/TD]
[TD]300[/TD]
[TD]240[/TD]
[/TR]
[TR]
[TD]Importer 5[/TD]
[TD]March -17[/TD]
[TD]GB[/TD]
[TD]10[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]Importer 2[/TD]
[TD]March -17[/TD]
[TD]ZM[/TD]
[TD]60[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]March -17[/TD]
[TD]SY[/TD]
[TD]11[/TD]
[TD]8[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Welcome to the forum

Test this in a COPY of your workbook
- assumes that the workbook contains only monthly sheets and that first header is in cell A1 in all sheets
- the VBA creates the 2 new sheets required

You stated that Importer is sometimes blank
- but gave no reason
- so assumption is that is how they should remain

You said I need to copy all mass values less than 20 and paste them to a new sheet called "under20", and transfer the rest to "over20"
- what about = 20 ?
- I have include in the "over 20" sheet


Code:
Sub ConsolSheets()
    Dim ws1 As Worksheet, ws2 As Worksheet, copyRng As Range, pasteRng As Range, Rng As Range, s As Long
    Set ws1 = Sheets.Add(Before:=Sheets(1)): ws1.Name = "Over 20"
        With Sheets(2).Range("A1").CurrentRegion.Resize(1)
            .Copy ws1.Cells(1)
            .Copy:  ws1.Cells(1).PasteSpecial (xlPasteColumnWidths)
        End With
        On Error Resume Next
        For s = 2 To ThisWorkbook.Sheets.Count
            Set copyRng = Sheets(s).Range("A1").CurrentRegion.Offset(1)
            Set pasteRng = ws1.Range("A1").CurrentRegion
            Set pasteRng = pasteRng.Offset(pasteRng.Rows.Count).Resize(1, 1)
            copyRng.Copy pasteRng
        Next s
    
        ws1.Copy Before:=Sheets(1): Set ws2 = Sheets(1):  ws2.Name = "Under 20"
    
        Set Rng = ws2.Range("A1").CurrentRegion.Offset(1)
        ws2.Range("A:E").AutoFilter Field:=4, Criteria1:=">=20"
        Rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
        ws2.ShowAllData
    
        Set Rng = ws1.Range("A1").CurrentRegion.Offset(1)
        ws1.Range("A:E").AutoFilter Field:=4, Criteria1:="<20"
        Rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
        ws1.ShowAllData
End Sub

The VBA
- creates a new sheet
- copies ALL values to new sheet
- duplicates new sheet
- deletes under20s from one and over20s from the other
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,260
Members
452,627
Latest member
KitkatToby

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