Snasui Excel Forum

Code: Select all

Sub Copy_2()
    Dim r As Range, rAll As Range
    With Sheets("Sheet1")
        Set rAll = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With
    For Each r In rAll
        Select Case r.Value
            Case "UCELLCAC"
                Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp). _
                    Offset(1, 0).EntireRow = r.EntireRow.Value
            Case "UCELLHCS"
                Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp). _
                    Offset(1, 0).EntireRow = r.EntireRow.Value
            Case "UCELLDRD"
                Sheets("Sheet4").Range("A" & Rows.Count).End(xlUp) _
                    .Offset(1, 0).EntireRow = r.EntireRow.Value
            Case "UCELLINTERFREQHOCOV"
                Sheets("Sheet5").Range("A" & Rows.Count).End(xlUp) _
                    .Offset(1, 0).EntireRow = r.EntireRow.Value
            Case "UCELLINTERRATHOCOV"
                Sheets("Sheet6").Range("A" & Rows.Count).End(xlUp) _
                    .Offset(1, 0).EntireRow = r.EntireRow.Value
            Case "UCELLINTRAFREQHO"
        End Select
    Next r
End Sub