Snasui Excel Forum

Code: Select all

Sub test0()
    Dim rallName As Range
    Dim rRoom As Range
    Dim r As Range, i As Integer
    With Sheets("Sheet1")
       Set rallName = .Range("l2", .Range("l" & .Rows.Count).End(xlUp))
        Set rRoom = .Range("i2", .Range("i" & .Rows.Count).End(xlUp))
        i = rRoom.Rows.Count
        For Each r In rallName
            With .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0)
                .Resize(i, 1).Value = r.Value
                .Offset(0, 1).Resize(i, 1).Value = rRoom.Value
            End With
        Next r
    End With
End Sub