Loop to copy from multiple files and sheets to one long list

Hi sdb

Housekeeping thing first - please could you edit your post and surround your code with code tags (start with [ c o d e ] and end with [ / c o d e ] no spaces.)? Makes it easier to read, and is a forum rule. Thanks.

You don't need to swap between workbooks. You can just refer to the workbook, worksheet and range from where you are. Unfortunately, the macro recorder doesn't really help in learning this!

Also, set a variable as any workbook or worksheet you are going to use frequently - saves on typing!

Anyway, here's a loop for you:

Sub LoopThrough(strSheet As String)
Dim wb As Workbook, ws As Worksheet, Wwb As Workbook
Dim destn As Range
Set Wwb = Workbooks("Weekly.xls")
Set ws = Wwb.Sheets("Summary")

For Each wb In Application.Workbooks
  If wb.Name <> "Weekly.xls" Then
    'Set the destination as the last cell in column K,
    'offset (1,0) to get the next one down.
    Set destn = ws.Range("K65000").End(xlUp).Offset(1, 0)
    wb.Sheets(strSheet).Range("A4:P43").Copy Destination:=destn

    'Reset destn
    Set destn = ws.Range("K65000").End(xlUp).Offset(1, 0)
    wb.Sheets(strSheet).Range("R4:AG43").Copy Destination:=destn
    End If

  Next wb

End Sub

Put this in a module in your workbook. For the Checkbox click code, just send the sheet to the above code:

Private Sub CheckBox10_Click()
Call LoopThrough("10")
End Sub

I'm assuming it will be the same sheet in every workbook, e.g. "1" or "10", etc.

Cheers, Rob.

Thank you for the house keeping tips! I was not aware of the protocol.

That code is awesome by the way it even got rid of that incessant screen seizure!

I have one more question to ask. So you are familiar with the output format, one long list. I was wondering if you knew how to automatically populate columns that will take the sheet say "daily shift.xls" and put a column for shift and have a 1 for that and say 2 for "second shift.xls" etc. Also, the day of the month from the sheet number. so check box one would autofill the columns for that day as 1, and 2 for all the sheets "2" etc.?

Also, what if I wanted the output data to be transposed, what would the code need to be?

 Set destn = ws.Range("D65000").End(xlUp).Offset(1, 0)
    wb.Sheets(strSheet).Range("A4:P43").Copy Destination:=destn, transpose:=true

does not work