Complex Macro

Viking1221

New Member
Joined
May 25, 2017
Messages
32
Hello all,

I am looking for some assistance with a complex macro. I need to pull in all data in tabs between 'Start' and 'End' in my workbook into one tab called 'journals'. The trick is, I need to pull in all the data from each tab in columns JK:MX. Then I need to stack the data so tab 1 would have its data copied over as values, then tab2's data would be paste under it and so forth. "Start" and "End" tabs are blank if that makes it easier. After all the data is pasted I would need to removed all lines with all zero's from the 'journals' tab.

Can this be done?

Thanks in advance.
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
If you do not want the copied range entered into column A of sheet 'journal' then change the A in red font to the column where you want the data to begin when pasted.

Code:
Sub t()
Dim i As Long, s As Long, e As Long
s = Sheets("Start").Index + 1
e = Sheets("End").Index - 1
    For i = s To e
        Intersect(Sheets(i).UsedRange, Sheets(i).Range("JK:Mx")).Copy _
        Sheets("journal").Cells(Rows.Count, [COLOR=#b22222]"A"[/COLOR]).End(xlUp)(2)
    Next
End Sub

You should not assume that responders know where you want copied data to go.
 
Last edited:
Upvote 0
If you do not want the copied range entered into column A of sheet 'journal' then change the A in red font to the column where you want the data to begin when pasted.

Code:
Sub t()
Dim i As Long, s As Long, e As Long
s = Sheets("Start").Index + 1
e = Sheets("End").Index - 1
    For i = s To e
        Intersect(Sheets(i).UsedRange, Sheets(i).Range("JK:Mx")).Copy _
        Sheets("journal").Cells(Rows.Count, [COLOR=#b22222]"A"[/COLOR]).End(xlUp)(2)
    Next
End Sub

You should not assume that responders know where you want copied data to go.


Thanks that work great, how can I just past values? Also, is there a way to delete all rows with all zeros?
 
Upvote 0
is there a way to delete all rows with all zeros?
Do you want to delete a row if the zero appears anywhere in the row, a certain column in the row or zeros in every column? Do blanks count as zeros? If blank by formula, still delete?
Please be specific.

This will paste values only.

Code:
Sub t()
Dim i As Long, s As Long, e As Long
s = Sheets("Start").Index + 1
e = Sheets("End").Index - 1
    For i = s To e
        Intersect(Sheets(i).UsedRange, Sheets(i).Range("JK:Mx")).Copy
        Sheets("journal").Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial xlPasteValues
    Next
End Sub
 
Upvote 0
Do you want to delete a row if the zero appears anywhere in the row, a certain column in the row or zeros in every column? Do blanks count as zeros? If blank by formula, still delete?
Please be specific.

This will paste values only.

Code:
Sub t()
Dim i As Long, s As Long, e As Long
s = Sheets("Start").Index + 1
e = Sheets("End").Index - 1
    For i = s To e
        Intersect(Sheets(i).UsedRange, Sheets(i).Range("JK:Mx")).Copy
        Sheets("journal").Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial xlPasteValues
    Next
End Sub

Sorry I should have been more specific. I am looking stack all the data and delete all blank row and rows that only have zero's in all the columns
 
Upvote 0
also deletes sum zero rows.

Code:
Sub t()
Dim i As Long, s As Long, e As Long, lr As Long
s = Sheets("Start").Index + 1
e = Sheets("End").Index - 1
    For i = s To e
        Intersect(Sheets(i).UsedRange, Sheets(i).Range("JK:MX")).Copy
        Sheets("journal").Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial xlPasteValues
    Next
    With Sheets("journal")
        lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
        For j = lr To 2 Step -1
            If Application.Sum(Rows(j)) = 0 Then
                .Rows(j).Delete
            End If
        Next
    End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,885
Messages
6,175,184
Members
452,615
Latest member
bogeys2birdies

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