Dynamic Macro Input

[Craig]

I am trying to create a Macro that will sort a multi-column, multi-row
set of data. Sorting on one column is simple using the Excel built in
sort function. Once the sorting is complete, I would like the macro
to take each unique set of data, by row, and create a new spreadsheet
with just that data included.

What I am finding difficult is to have the macro dynamically sense
which data belongs together, then copy and paste it into a new sheet.
Is there some stock code that someone has to do this or is there a
function in Excel that I can readily use? I've been stumped by this
for a while.

Thanks in advance!

craig.

 

[Trevor Shuttleworth]

Craig

I think you're going to have to tell us what the rules are so that we know
"which data belongs together"

Are you saying that you need a new sheet for each row of data ?

Something like this might do what you want:

Sub NewSheets()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A65536").End(xlUp).Row
For i = 1 To LastRow
Set NewSheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
NewSheet.Name = "data " & i
Sheets("Sheet1").Range("A" & i).EntireRow.Copy NewSheet.Range("A1")
Next 'i
End Sub

Assumes that the "master" sheet is Sheet1

Regards

Trevor

 

[Craig]

Thanks for the feedback so far. This looks like it might be along the
lines of what I need.

Based upon an initial sort that I do (this will be part of the macro),
I am able to see that there should be anywhere from 1-10 rows that
belong together (same data value) in a new sheet.

Seems like I need to scan the document to determine which rows belong
together, create a new sheet, copy the data there and start the
process again until all the rows have been copied to new sheets. Does
this help?

Thanks in advance!

craig.

 

[Trevor Shuttleworth]

Craig

try something like this:

Sub CreateNewSheets()
Dim MasterSheet As Worksheet
Dim NewSheet As Worksheet
Dim LastRow As Long
Dim i As Long
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set MasterSheet = Worksheets("Sheet1")
With MasterSheet
LastRow = .Range("A65536").End(xlUp).Row
.Range("A1").Sort _
Key1:=.Range("A2"), _
Order1:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End With
With MasterSheet
For i = 2 To LastRow
If .Range("A" & i) <> .Range("A" & i).Offset(-1, 0) Then
Set NewSheet =
Worksheets.Add(after:=Worksheets(Worksheets.Count))
NewSheet.Name = MasterSheet.Range("A" & i).Value
.Range("A1").EntireRow.Copy NewSheet.Range("A1")
End If
.Range("A" & i).EntireRow.Copy
With NewSheet
.Range("A65536").End(xlUp).Offset(1, 0).Select
.Paste
Application.CutCopyMode = False
End With
Next 'i
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
On Error GoTo 0
End Sub

Probably not the most efficient but it should be OK for a relatively small
number of rows. Note that if it is rerun it won't name the worksheets. It
would be better to build a range to be copied and then copy and paste once
for each change of key value ... but that can be your challenge !

Regards

Trevor