Need macro for all open workbooks 1st columnc copy

**aehartle** · 08-25-2010, 12:42 PM

I was giving me a syntax error

Sub LoopThroughSheets()
Dim wbBook As Workbook, rCopy As Range, rPaste As Range

With Worksheets("Budget")
For Each wbBook In Workbooks
If wbBook.Name <> ThisWorkbook.Name Then
Set rPaste = .Range&(A65536").End(xlUp).Offset(1, 0)
Set rCopy = wbBook.Range(Range("A1"), Range("A1").End(xlDown))
rCopy.Copy Destination:=rPaste
End If
Next
End With

If i can get it to open a new workbook and paste it into sheet 1 that would be great...

**sweep** · 08-25-2010, 12:45 PM

If you're posting code, please wrap it in code tags as described here.

Typo, sorry

Please replace with this

Set rPaste = .Range("A65536").End(xlUp).Offset(1, 0)

Paste this code into an empty workbook and run it.

**aehartle** · 08-25-2010, 12:48 PM

Sorry

<script type="text/javascript">
<!--
    alert("Sub CopyFirstColumns()
    Dim strAddress As String
    Dim shtData As Worksheet
    Dim shtUpload As Worksheet
    Dim lngCol As Long
    Dim lngRow As Long
    
    strAddress = "A1:A500"
    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);
//-->
</script>