Copy 1st column in every tab in work book and paste on Final

**Andy Pope** · 06-12-2010, 06:07 AM

something like this?

Sub CopyFirstColumns()
    Dim strAddress As String
    Dim shtData As Worksheet
    Dim shtUpload As Worksheet
    Dim lngCol As Long
    
    strAddress = "A1:A100"
    Set shtUpload = Worksheets("Upload")
    For Each shtData In Worksheets
        If shtData.Name <> shtUpload.Name Then
            lngCol = lngCol + 1
            shtData.Range(strAddress).Copy shtUpload.Cells(1, lngCol)
        End If
    Next
    
End Sub

**aehartle** · 06-13-2010, 12:11 PM

Kind of... I noticed in your code it puts the first column in the corresponding next column on the upload tab.

Is it possible to put all first column in one colum...meaning tab 1 has data from A1:A20 and Tab 2 has data from A1:A24. So on the upload tab i should have data from A1:A44. Does that explain it?

Thank you in advance

**aehartle** · 06-14-2010, 04:08 PM

Any ideas?

**Andy Pope** · 06-15-2010, 08:02 AM

Sub CopyFirstColumns()
    Dim strAddress As String
    Dim shtData As Worksheet
    Dim shtUpload As Worksheet
    Dim lngCol As Long
    Dim lngRow As Long
    
    strAddress = "A1:A100"
    Set shtUpload = Worksheets("Upload")
    lngRow = 1
    For Each shtData In Worksheets
        If shtData.Name <> shtUpload.Name Then
            shtData.Range(strAddress).Copy shtUpload.Cells(lngRow, 1)
            lngRow = shtUpload.Cells(shtUpload.Rows.Count, 1).End(xlUp).Row + 1
        End If
    Next
    
End Sub