Loop, copy, past

[Robbyn]

Greetings,

I'm looking for simple code that will loop through my worksheets, copy data
from column A (data ends on different rows on each sheet), and paste it to
column A in sheet 1.

I really appreciate the help - I don't know what I would do without this
group.

 

[Rick Rothstein]

Does this macro do what you want?

Sub CopyColAData()
Dim WS As Worksheet
Dim LR As Long
Dim LastRow As Long
Const DataColumn As String = "A"
Const SummarySheet As String = "Sheet1"
With Worksheets(SummarySheet)
LastRow = .Cells(.Rows.Count, DataColumn).End(xlUp).Row
If Not (LastRow = 1 And .Cells(LastRow, DataColumn).Value = "") Then
LastRow = LastRow + 1
End If
For Each WS In Worksheets
If StrComp(WS.Name, SummarySheet, vbTextCompare) <> 0 Then
LR = WS.Cells(WS.Rows.Count, DataColumn).End(xlUp).Row
WS.Range("A1:A" & LR).Copy .Cells(LastRow, DataColumn)
LastRow = LastRow + LR
End If
Next
End With
End Sub

 

[Robbyn]

Is perfect! Thank you sooo much!

Does this macro do what you want?

Sub CopyColAData()
Dim WS As Worksheet
Dim LR As Long
Dim LastRow As Long
Const DataColumn As String = "A"
Const SummarySheet As String = "Sheet1"
With Worksheets(SummarySheet)
LastRow = .Cells(.Rows.Count, DataColumn).End(xlUp).Row
If Not (LastRow = 1 And .Cells(LastRow, DataColumn).Value = "") Then
LastRow = LastRow + 1
End If
For Each WS In Worksheets
If StrComp(WS.Name, SummarySheet, vbTextCompare) <> 0 Then
LR = WS.Cells(WS.Rows.Count, DataColumn).End(xlUp).Row
WS.Range("A1:A" & LR).Copy .Cells(LastRow, DataColumn)
LastRow = LastRow + LR
End If
Next
End With
End Sub