Data Sorting Question

bergsh

New Member
Joined
Sep 12, 2006
Messages
13
Here is my question. I have a workbook that has worksheet names that change depending on the day. I could have as many as 30 different sheets at one time. I am trying to write a macro that will sort the 4 of the worksheets data into one master file in a different location.
Here is the code I have thus far:

Sub Disperse_Data1()

Sheets(" 4828-010O").Select
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Open Filename:= _
"C:\Documents and Settings\A369747.000\My Documents\AC Hose Dimensional Data.xls"
Range("A1").Select
ActiveSheet.Paste
Range("C1").Select
Windows("sorted.xls").Activate
Sheets(" 4828-010I").Select
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AC Hose Dimensional Data.xls").Activate
Range("C1").Select
ActiveSheet.Paste
Windows("sorted.xls").Activate
Sheets(" 4828-010V").Select
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AC Hose Dimensional Data.xls").Activate
Range("D1").Select
ActiveSheet.Paste
Windows("sorted.xls").Activate
End Sub

This process would need to be repeated a varying number of times dpending upon the worksheet titles in the source ("sorted.xls") workbook. The range of worksheet titles in this workbook can be as many as 550 different worksheet names.
So my question is there an easier way and does anyone have a better way to approach this problem.
Thanks for your help in advance.
Shawn
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

PolarBear

Board Regular
Joined
Sep 26, 2005
Messages
215
Why not try using index numbers to refer to the sheets instead of names?
Code:
NumSheets = Workbooks("Sorted").Worksheets.Count
For i = 0 to NumSheets
     Worksheets(i).Activate
     (do your copy)
     Worksheets("AC Hose Data").Activate
     (do your paste - may need a counter if the target destination changes)
Next i

Hope this helps get you on track...
 

bergsh

New Member
Joined
Sep 12, 2006
Messages
13
If I use this counter? Can I still associate the worksheet names in "sorted" with the names in the new workbook I am pasting information into? My thought is that with each time I run the macro, I will end up with different worksheet names being numbered some different number each time. And therefore I would not know how to get the numbered sheet to input the copied information into the correct sheet. Is there a way to clear this up and still associate the indexed number to the corresponding sheet in another workbook?
 

PolarBear

Board Regular
Joined
Sep 26, 2005
Messages
215
I'm confused; let's try to use some standard terms - you have many source sheets, and a single destination sheet ("AC Hose"). From the code you posted, you copy some data from various source sheets into a cell that seems to move down in your destination sheet. (Go back and look at the code you posted; you never even specify which sheet in "AC Hose" is to receive the data, so I assumed there was only one sheet there.)

If you are saying that you want to copy data from the various source sheets to many different sheets in the destination file, you'll have to tell us what sheets are the destination and how the name(s) of the destination sheets relate to the names of the source sheets.

I really think there's an easy way to do what you want, but you need to take a few minutes, and specify exactly what you need.
 

bergsh

New Member
Joined
Sep 12, 2006
Messages
13
Sorry about that, I have gotten it working mostly the way I intended. I will post the code that I had to write in order to make it work. I am still wondering if there is a shorter way. I am a bit worried that I will run into a problem with locking up the computer with such a large macro. But I will not know this until I complete the macro I suppose. So anyway here is the code:

Sub Disperse_Data()
'
' Disperse_Data Macro
' Macro recorded 9/14/2006 by Goodyear Tire and Rubber Co
Dim ws As Worksheet

'
Workbooks.Open Filename:= _
"C:\Documents and Settings\A369747.000\My Documents\AC Hose Dimensional Data.xls"
Windows("Sorted.xls").Activate
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = " 4828-010O" Then
Windows("Sorted.xls").Activate
Sheets(" 4828-010O").Select
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AC Hose Dimensional Data.xls").Activate
Sheets(" 4828-010").Select
Range("A1").Select
ActiveSheet.Paste
Windows("Sorted.xls").Activate
Sheets(" 4828-010I").Select
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AC Hose Dimensional Data.xls").Activate
Sheets(" 4828-010").Select
Range("C1").Select
ActiveSheet.Paste
Windows("Sorted.xls").Activate
Sheets(" 4828-010V").Select
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AC Hose Dimensional Data.xls").Activate
Sheets(" 4828-010").Select
Range("D1").Select
ActiveSheet.Paste
End If
'Next ws
If ws.Name = " 4826-013O" Then
Windows("Sorted.xls").Activate
Sheets(" 4826-013O").Select
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AC Hose Dimensional Data.xls").Activate
Sheets(" 4826-013").Select
Range("A1").Select
ActiveSheet.Paste
Windows("Sorted.xls").Activate
Sheets(" 4826-013I").Select
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AC Hose Dimensional Data.xls").Activate
Sheets(" 4826-013").Select
Range("C1").Select
ActiveSheet.Paste
Windows("Sorted.xls").Activate
Sheets(" 4826-013V").Select
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AC Hose Dimensional Data.xls").Activate
Sheets(" 4826-013").Select
Range("D1").Select
ActiveSheet.Paste
End If
'Next ws
If ws.Name = " 4880-020O" Then
Windows("Sorted.xls").Activate
Sheets(" 4880-020O").Select
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AC Hose Dimensional Data.xls").Activate
Sheets(" 4880-020").Select
Range("A1").Select
ActiveSheet.Paste
Windows("Sorted.xls").Activate
Sheets(" 4880-020I").Select
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AC Hose Dimensional Data.xls").Activate
Sheets(" 4880-020").Select
Range("C1").Select
ActiveSheet.Paste
Windows("Sorted.xls").Activate
Sheets(" 4880-020V").Select
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("AC Hose Dimensional Data.xls").Activate
Sheets(" 4880-020").Select
Range("D1").Select
ActiveSheet.Paste
End If
Next ws
End Sub
 

Forum statistics

Threads
1,136,275
Messages
5,674,783
Members
419,524
Latest member
helensesc

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top