Complex Macro

[Viking1221]

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.

 

[JLGWhiz]

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.

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.

 

[Viking1221]

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.

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?

 

[JLGWhiz]

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.

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

 

[Viking1221]

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.

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

 

[JLGWhiz]

also deletes sum zero rows.

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