Snasui Excel Forum

Code: Select all

Sub MoveDataAll()
    Dim rAll As Range
    Dim i As Integer
    With Sheets("Sheet1")
        Set rAll = .Range("B1", .Range("B1").End(xlDown).End(xlToRight))
        For i = 1 To rAll.Columns.Count
            rAll.Columns(i).Copy
            .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
                .PasteSpecial xlPasteValues
        Next i
        rAll.ClearContents
        .Range("A1").Activate
    End With
End Sub