Where's the code error?

[Factor3]

So this code "seems" like it should work, but it's not working (I'm sure you've never heard that before:rotlaugh: ).

I've got some workbooks that have cosistent ranges on them:
Worksheets(1).Range("B5:B246")
I'm trying to copy this range from every single workbook, and place it onto a "Summary" workbook (I though the copy and offset method was appropriate here).


Sub Compile_Indexes()

Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim indx As Range

'This is the summary workbook that will compile the ranges
Set wbk2 = Workbooks("summary")

'This begins the process of sorting through each of the workbooks that are open

For Each wbk1 In Workbooks 'Workbooks will refer to all open workbooks,right?
If Not wbk1.Name = wbk2.Name Then
'This automates the copying of ranges and pastes them into the summary book
For Each indx In wbk1.Worksheets(1).Range("B5:B246")
indx.Copy Destination:=wbk2.Worksheets(1).Range("B:B").Offset(0, 1)
Next indx
End If
Next wbk1
End Sub

Thanks so much,

Benjamin

[Bob Phillips]

Sub Compile_Indexes()
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim indx As Range
Dim LastRow As Long

'This is the summary workbook that will compile the ranges
Set wbk2 = Workbooks("summary")

'This begins the process of sorting through each of the workbooks that are open

For Each wbk1 In Workbooks 'Workbooks will refer to all open workbooks,right?
If Not wbk1.Name = wbk2.Name Then
LastRow = wbk2.Worksheets(1).Cells(wbk2.Worksheets(1).Rows.Count, "B").End(xlUp).Row
If LastRow > 1 Or wbk2.Worksheets(1).Cells(LastRow, "B").Value <> "" Then
LastRow = LastRow + 1
End If
'This automates the copying of ranges and pastes them into the summary book
For Each indx In wbk1.Worksheets(1).Range("B5:B246")
indx.Copy Destination:=wbk2.Worksheets(1).Range("B" & LastRow).Offset(0, 1)
Next indx
End If
Next wbk1
End Sub

[mdmackillop]

I'm guessing you want the results in adjoining columns
Sub Compile_Indexes2()

Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim indx As Range
Dim i As Long

'This is the summary workbook that will compile the ranges
Set wbk2 = Workbooks("summary")

'This begins the process of sorting through each of the workbooks that are open

For Each wbk1 In Workbooks 'Workbooks will refer to all open workbooks,right?
If Not wbk1.Name = wbk2.Name Then
'This automates the copying of ranges and pastes them into the summary book
wbk1.Worksheets(1).Range("B5:B246").Copy Destination:=wbk2.Worksheets(1).Range("B:B").Offset(0, i + 1)
i = i + 1
End If
Next wbk1
End Sub

[Factor3]

Number 1, I can't believe that what I had was actually CLOSE to getting the darn thing right!

Number 2, mdmackillop, you ROCK!!!!!! I guess I threw in that extra For Each
Next

Loop that really wasn't necessary. I added some column deletions and autofits, and this is PERFECT!!!!:clap:

A Good day to you sir.

[mdmackillop]

Happy to help. The only other change might be to set the destination as a single cell, rather than the column, as in
Destination:=wbk2.Worksheets(1).Range("B5").Offset(0, i + 1)