Snasui Excel Forum

Code: Select all

Sub UpWages()
    Dim rSource As Range
    Dim r As Range, rTarget As Range
    Worksheets("Data").Range("a1").CurrentRegion.Offset(1, 0).ClearContents
    With Worksheets("Template")
        Set rSource = .Range("D2", .Range("D" & .Rows.Count).End(xlUp))
        For Each r In rSource
            If r.Value > 0 Then
               Worksheets("Data").Range("a" & .Rows.Count) _
                .End(xlUp).Offset(1, 0).Resize(1, 5).Value = _
                r.Offset(0, -3).Resize(1, 5).Value
            End If
        Next r
    End With
End Sub

Code: Select all

Sub UpWages()
        Dim rSource As Range
        Dim rTarget As Range
        With Worksheets("Template")
            Set rSource = .Range("A2:E2").Resize(.Range("G1"))
        End With
        Set rTarget = Worksheets("Data").Range("A65536").End(xlUp).Offset(1, 0)
            rSource.Copy
            rTarget.PasteSpecial xlPasteValues
        Application.CutCopyMode = False
End Sub