Snasui Excel Forum

Code: Select all

Sub ShowEmp()
    Dim rAll As Range, r As Range
    Dim rt As Range, lng As Long
    Application.EnableEvents = False
    With Sheets("Database")
         Set rAll = .Range("A3", .Range("A" & Rows.Count).End(xlUp))
    End With
    With Sheets("Print")
        If .Range("B4") <> "" Then
            .Range("B4", .Range("G" & Rows.Count).End(xlUp)).ClearContents
        End If
    End With
    For Each r In rAll
        With Sheets("Print")
            If r = .Range("C1") Then
                Set rt = .Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
                lng = lng + 1
                rt = lng
                rt.Offset(0, 1) = r.Offset(0, 1)
                rt.Offset(0, 2) = r.Offset(0, 3)
                rt.Offset(0, 3) = r.Offset(0, 4)
                rt.Offset(0, 4) = r.Offset(0, 5)
                rt.Offset(0, 5) = r.Offset(0, 7)
            End If
        End With
    Next r
    Application.EnableEvents = True
End Sub