Moving between different workbooks

Hi Peter

The code below is a basic routine that rotates through all the open workbooks and copies data from preset ranges on them to the target (Active Workbook).

Copy the code into a module in the target Workbook and then call it from a button on the workbook.

You will note I put in comments on the code explaining steps.

Sub FindWorkBooks()

Dim WBK As Workbook

Dim intColumn As Integer 'Hold the number of values in the range

Dim intRangeCount As Integer

intColumn = 2 'The data from the first book goes to column 2

For Each WBK In Application.Workbooks

If WBK.Name <> ActiveWorkbook.Name Then

If WBK.Name <> "PERSONAL.XLS" Then 'Ignores the PERSONAL Workbook

'Count the number of cells in the named range and used to set the end cell of target
intRangeCount = RowsInNamedRange(Workbooks(WBK.Name).Sheets("Total Sales").Range("Makes"))

'Sheets(2) refers to the 2nd sheet in the Active workbook. For accuracy replace with the Sheet's name.
Sheets(2).Range(Cells(10, intColumn), Cells(intRangeCount + 9, intColumn)).Value = Workbooks(WBK.Name).Sheets("Total Sales").Range("Makes").Value
'The above copies the data from the Total Sales sheet in each open workbook
'to a new column in the Active workbook

intColumn = intColumn + 1 'Moves the focus to the next empty column

End If

End If

Next WBK

End Sub

'-------------------------------------------

Function RowsInNamedRange(NamedRange As Range) As Long
'This function counts the number of values in the named range

RowsInNamedRange = NamedRange.Rows.Count

End Function

Hope this helps

Carlos