Copy data from different columns of multiple sheets

[Scott]

I have to summarize the latest sales number from different offices, more than
40 of them. The numbers are sitting in one Excel file with each office having
one sheet. On each sheet the sales numbers for that office are listed
monthly. The latest number for some offices are for Nov, some Oct, and some
terminated offices with numbers as early as a couple of years ago.

Here is what I have to do: I have to go to each sheet (named "office 1" to
"office 50"), find the last column with data in that sheet and copy the
column to a new sheet (say Sheet "Summary"). In the new sheet, Column A for
data of Office 1, Column B for Office 2, etc.

Is there a way to program this process, other than copy-paste 50 times?

Thanks a lot.

 

[Mike H]

Scott,

This assumes a sheet called "Summary" already exists


Sub marine()
Dim MyCol As Long, x As Long
MyCol = Sheets("Summary").UsedRange.Columns.Count+1
For x = 1 To Worksheets.Count
If UCase(Left(Sheets(x).Name, 6)) = "OFFICE" Then
r = Sheets(x).UsedRange.Columns.Count
Sheets(x).Columns(r).Copy _
Destination:=Sheets("Summary").Cells(1, MyCol)
MyCol = MyCol + 1
End If
Next
End Sub


Mike

 

[Scott]

Mike,

Thank you very much. It works.

Scott

Scott,

This assumes a sheet called "Summary" already exists


Sub marine()
Dim MyCol As Long, x As Long
MyCol = Sheets("Summary").UsedRange.Columns.Count+1
For x = 1 To Worksheets.Count
If UCase(Left(Sheets(x).Name, 6)) = "OFFICE" Then
r = Sheets(x).UsedRange.Columns.Count
Sheets(x).Columns(r).Copy _
Destination:=Sheets("Summary").Cells(1, MyCol)
MyCol = MyCol + 1
End If
Next
End Sub


Mike

 

[Gord Dibben]

Scott

Be careful with Activesheet.usedrange.

May not be what you think it is.

Test...............

Run this........MsgBox ActiveSheet.UsedRange.Columns.Count + 1

Note the number returned.

Go to last column. Then go next blank column and enter a bunch of text in
several cells.

Clear Contents of these cells.........do not delete entire
columns......clear or delete cell contents only.

Save then re-open workbook.

Run...........MsgBox ActiveSheet.UsedRange.Columns.Count + 1

Note the number returned.

Now run this..........

MsgBox ActiveSheet.Cells(ActiveCell.Row, Columns.Count).End(xlToLeft).Column


Gord Dibben MS Excel MVP