Copying to another sheet.

[rdelosh74]

Need help on this please:




In a workbook, starting on sheet 5, going to the last sheet in the workbook (it can be any number of sheets).

Starting on row 4, if there is a value in Column T, U or V then copy the entire row to a new sheet at the end of the workbook (starting on row 4). And have that sheet called, "Totals".

Thank you.

[mancubus]

Try



Sub copy_data_from_sheets_5_to_n()


Dim ws As Worksheet
Dim i As Long, j As Long, LastRow As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

On Error Resume Next
For Each ws In Worksheets
If UCase(ws.Name) = "TOTALS" Then ws.Delete
Next ws

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Totals"

For i = 5 To Worksheets.Count - 1
With Worksheets(i)
LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
For j = 4 To LastRow
If Application.CountA(.Range("T" & j & ":V" & j)) > 0 Then
.Rows(j).Copy Worksheets("Totals").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next j
End With
Next i


End Sub

[rdelosh74]

Doesn't work correctly. I have added a file showing the final output how it should look. Notice there are hidden columns.

11950

Thanks for the attempt.

[mancubus]

actually it will work for the requirement in your first message. with well designed worksheets, of course.


the workbook you posted tells me you want to copy columns A-V to totals.




Sub copy_data_from_sheets_5_to_n()

Dim ws As Worksheet
Dim i As Long, j As Long, LastRow As Long, LRTotals As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

On Error Resume Next
For Each ws In Worksheets
If UCase(ws.Name) = "TOTALS" Then ws.Delete
Next ws

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Totals"
LRTotals = 4

For i = 5 To Worksheets.Count - 1
With Worksheets(i)
LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
For j = 4 To LastRow
If Application.CountA(.Range("T" & j & ":V" & j)) > 0 Then
.Range("A" & j & ":V" & j).Copy Worksheets("Totals").Range("A" & LRTotals)
LRTotals = Worksheets("Totals").Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
End If
Next j
End With
Next i

End Sub

[rdelosh74]

That worked perfectly. Thank you.

[mancubus]

you are welcome.