Copy data from multiple worksheets to one sheet

[kaydee1]

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]

 

[Yongle]

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

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

 

[kaydee1]

Thank you very much, i like your summary its exactly what i need. it worked without any problems.

 

[Yongle]

thanks for feedback