Snasui Excel Forum

Code: Select all

Sub CollectData()
    Dim ws As Worksheet
    Dim r As Range
    Dim rTarget As Range
    Dim DataAll As String
    DataAll = "Sheet3"
    Application.ScreenUpdating = False
    For Each ws In Worksheets
        If ws.Name <> DataAll Then
            With Sheets(DataAll)
                Set rTarget = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            End With
            Set r = ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp))
                r.SpecialCells(xlCellTypeConstants).EntireRow.Copy
                rTarget.PasteSpecial xlPasteValues
        End If
    Next ws
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub CollectData()
    Dim ws As Worksheet
    For Each ws In Worksheets
        If ws.Name <> "Sheet3" Then
             ws.UsedRange.Copy Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
        End If
    Next ws
    Application.CutCopyMode = False
End Sub

Code: Select all

ws.UsedRange.Copy Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)

Code: Select all

ws.UsedRange.Copy Cells(1, Columns.Count).End(xlToLeft).Offset(1, 0)

Code: Select all

ws.UsedRange.Resize(ws.UsedRange.Rows().Count, 1).Copy Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)

Code: Select all

Sub CollectData()
    Dim ws As Worksheet
    Dim source As Range
    Dim target As Range
    For Each ws In Worksheets
        If ws.Name <> "Sheet3" Then
            With ws.UsedRange
                     Set source = .Offset(0, 1).Resize(.Rows.Count)
                     Set target = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
                     source.Copy target
            End With
        End If
    Next ws
    Application.CutCopyMode = False
End Sub