VBA to copy a row from multiple tabs to a summary tab based on criteria met

R

rmwindham

New Member
Joined
Mar 17, 2014
Messages
17
Hello,
I need some help with some code to copy a row of data from multiple tabs to a summary tab. What I have is a worksheet with several tabs, all formatted the same, in column G, there is a calculation of the number of days a case has been open, when that data gets to be >90, I need that row, column A to I to copy to the next empty row on the "Summary" tab. I have looked on here and found some similar scenarios, but none seem to work for what I want. Any help will be appreciated. Thanks
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Sort by date Sort by votes
Code: 
Sub Macro1()
sht1 = "Sheet1"
sht2 = "Sheet2"
sht2DataStart = 1
numRow = 1 'used to keep track of what row number in sht2 it's currently on in the Loop
newRow = 1 'used to keep track of where to enter the new row in sht1
clearSht = Sheets(sht1).Range("G" & Rows.Count).End(xlUp).Row
Sheets(sht1).Range("A" & newRow & ":I" & clearSht).ClearContents
lastRow = Sheets(sht2).Range("G" & Rows.Count).End(xlUp).Row
    For Each cell In Sheets(sht2).Range("G" & sht2DataStart & ":G" & lastRow).Value
        If Sheets(sht2).Range("G" & numRow).Value > 90 Then
            Sheets(sht1).Range("A" & newRow).Value = Sheets(sht2).Range("A" & numRow).Value
            Sheets(sht1).Range("B" & newRow).Value = Sheets(sht2).Range("B" & numRow).Value
            Sheets(sht1).Range("C" & newRow).Value = Sheets(sht2).Range("C" & numRow).Value
            Sheets(sht1).Range("D" & newRow).Value = Sheets(sht2).Range("D" & numRow).Value
            Sheets(sht1).Range("E" & newRow).Value = Sheets(sht2).Range("E" & numRow).Value
            Sheets(sht1).Range("F" & newRow).Value = Sheets(sht2).Range("F" & numRow).Value
            Sheets(sht1).Range("G" & newRow).Value = Sheets(sht2).Range("G" & numRow).Value
            Sheets(sht1).Range("H" & newRow).Value = Sheets(sht2).Range("H" & numRow).Value
            Sheets(sht1).Range("I" & newRow).Value = Sheets(sht2).Range("I" & numRow).Value
            newRow = newRow + 1
        End If
        numRow = numRow + 1
    Next
End Sub
 
Upvote 0
Thanks for the help, only it seems your code has sheet1 which I assume is the Summary and sheet2, mine has about 20 sheets, and then a Summary sheet. I am not sure how to adapt your code for all the sheets in my workbook
 
Upvote 0
This code works. There is only 1 catch. If a worksheet doesn't exist, it brings back an error. I can't figure out how to bypass it. So you'll have to tell the code how many worksheets you have and what the names of them are. Any mistake there and the entire thing crashes.

Code: 
Sub Macro1()
[COLOR=#ff0000]  sht1 = "Sheet1" [/COLOR][COLOR=#008000]'Summary Sheet[/COLOR][COLOR=#ff0000]
    sht2 = "Sheet2"
    sht3 = "Sheet3"
    sht4 = "Sheet4"
    sht5 = "Sheet5"
    sht6 = "Sheet6"
    sht7 = "Sheet7"
    sht8 = "Sheet8"
    sht9 = "Sheet9"
    sht10 = "Sheet10"
    sht11 = "Sheet11"
    sht12 = "Sheet12"
    sht13 = "Sheet13"
    sht14 = "Sheet14"
    sht15 = "Sheet15"
    sht16 = "Sheet16"
    sht17 = "Sheet17"
    sht18 = "Sheet18"
    sht19 = "Sheet19"
    sht20 = "Sheet20"
    sht21 = "Sheet21"[/COLOR]
    shtCounter = 1 [COLOR=#008000]'used to keep track of which sheet it is currently looping through.[/COLOR]
    [COLOR=#ff0000]totalSheets = 21[/COLOR] [COLOR=#008000]'this is the number of sheets you are searching through including the summary sheet.[/COLOR]
    
    
    newRow = 1 [COLOR=#008000]'used to keep track of where to enter the new row in sht1.[/COLOR]
    clearSht = Sheets(sht1).Range("G" & Rows.Count).End(xlUp).Row
    Sheets(sht1).Range("A" & newRow & ":I" & clearSht).ClearContents
    Do While shtCounter < totalSheets
        If shtCounter = 1 Then
            shtName = sht2
        End If
        If shtCounter = 2 Then
            shtName = sht3
        End If
        If shtCounter = 3 Then
            shtName = sht4
        End If
        If shtCounter = 4 Then
            shtName = sht5
        End If
        If shtCounter = 5 Then
            shtName = sht6
        End If
        If shtCounter = 6 Then
            shtName = sht7
        End If
        If shtCounter = 7 Then
            shtName = sht8
        End If
        If shtCounter = 8 Then
            shtName = sht9
        End If
        If shtCounter = 9 Then
            shtName = sht10
        End If
        If shtCounter = 10 Then
            shtName = sht11
        End If
        If shtCounter = 11 Then
            shtName = sht12
        End If
        If shtCounter = 12 Then
            shtName = sht13
        End If
        If shtCounter = 13 Then
            shtName = sht14
        End If
        If shtCounter = 14 Then
            shtName = sht15
        End If
        If shtCounter = 15 Then
            shtName = sht16
        End If
        If shtCounter = 16 Then
            shtName = sht17
        End If
        If shtCounter = 17 Then
            shtName = sht18
        End If
        If shtCounter = 18 Then
            shtName = sht19
        End If
        If shtCounter = 19 Then
            shtName = sht20
        End If
        If shtCounter = 20 Then
            shtName = sht21
        End If
        sht2DataStart = 1
        numRow = 1 [COLOR=#008000]'used to keep track of what row number in sht2 and other lookup sheets it's currently on in the Loop.[/COLOR]
        If IsError(Sheets(shtName).Range("G" & Rows.Count).End(xlUp).Row) Then 'TEST
        ElseIf Sheets(shtName).Range("G" & Rows.Count).End(xlUp).Row = 1 Then 'TEST
            If Sheets(shtName).Range("G" & numRow).Value > 90 Then
                Sheets(sht1).Range("A" & newRow).Value = Sheets(shtName).Range("A" & numRow).Value
                Sheets(sht1).Range("B" & newRow).Value = Sheets(shtName).Range("B" & numRow).Value
                Sheets(sht1).Range("C" & newRow).Value = Sheets(shtName).Range("C" & numRow).Value
                Sheets(sht1).Range("D" & newRow).Value = Sheets(shtName).Range("D" & numRow).Value
                Sheets(sht1).Range("E" & newRow).Value = Sheets(shtName).Range("E" & numRow).Value
                Sheets(sht1).Range("F" & newRow).Value = Sheets(shtName).Range("F" & numRow).Value
                Sheets(sht1).Range("G" & newRow).Value = Sheets(shtName).Range("G" & numRow).Value
                Sheets(sht1).Range("H" & newRow).Value = Sheets(shtName).Range("H" & numRow).Value
                Sheets(sht1).Range("I" & newRow).Value = Sheets(shtName).Range("I" & numRow).Value
                newRow = newRow + 1
            End If
        Else
        lastRow = Sheets(shtName).Range("G" & Rows.Count).End(xlUp).Row
        For Each cell In Sheets(shtName).Range("G" & sht2DataStart & ":G" & lastRow).Value
            If Sheets(shtName).Range("G" & numRow).Value > 90 Then
                Sheets(sht1).Range("A" & newRow).Value = Sheets(shtName).Range("A" & numRow).Value
                Sheets(sht1).Range("B" & newRow).Value = Sheets(shtName).Range("B" & numRow).Value
                Sheets(sht1).Range("C" & newRow).Value = Sheets(shtName).Range("C" & numRow).Value
                Sheets(sht1).Range("D" & newRow).Value = Sheets(shtName).Range("D" & numRow).Value
                Sheets(sht1).Range("E" & newRow).Value = Sheets(shtName).Range("E" & numRow).Value
                Sheets(sht1).Range("F" & newRow).Value = Sheets(shtName).Range("F" & numRow).Value
                Sheets(sht1).Range("G" & newRow).Value = Sheets(shtName).Range("G" & numRow).Value
                Sheets(sht1).Range("H" & newRow).Value = Sheets(shtName).Range("H" & numRow).Value
                Sheets(sht1).Range("I" & newRow).Value = Sheets(shtName).Range("I" & numRow).Value
                newRow = newRow + 1
            End If
            numRow = numRow + 1
        Next
        End If 'TEST
        shtCounter = shtCounter + 1
    Loop
End Sub
You can delete all the parts where it says 'TEST
I was obviously testing lines of code to see if they worked. I forgot to delete the word TEST after it worked.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
copy data from one tab to another as a list
Replies
1
Views
262
Fluff
Fluff
G
  • Solved
Vlookup from multiple tabs at same time
Replies
3
Views
289
Fluff
Fluff
T
  • Question
VBA code to export specific variably named tabs to new workbook?
Replies
2
Views
404
thebigejr
T
B
  • Solved
VBA to copy and paste based on multiple conditions
Replies
7
Views
1K
Beginner001
B
VBAAccountant
  • Solved
VBA Code to copy data based on criteria to tab with the same name
Replies
3
Views
241
vcoolio
V

Forum statistics

Threads
1,214,788
Messages
6,121,575
Members
449,039
Latest member
Arbind kumar

Share this page

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