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.

sample714.xls

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.