Automate unique data to move to unique worksheets

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Here is what I'm trying to do:

I've pulled over data from an AS/400 system to an excel worksheet. Is there
a way to automate excel somehow to take, let's say, the information from
individual account numbers and put the data for those account numbers on
individual tabs or sheets within one workbook?

So if I had 4 account numbers with 500 lines of data for each, is there a
way to get excel to indentify those unique acct numbers and move them into
their own worksheets so that instead of all the information on one sheet, it
would now be on 4.

Thanks for your help.

Rob
 
It can be done. Are the account numbers in column A with header row as
follows:

Acount Number (row 1)
11111
11111
 
Yes, exactly

Joel said:
It can be done. Are the account numbers in column A with header row as
follows:

Acount Number (row 1)
11111
11111
.
.
.
11111
22222
22222
.
.
.
22222
33333
33333
.
.
.
33333
44444
44444
.
.
.
44444
Click to expand...
 
Sub movetonewpage()

LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
Set HeaderRange = Range(Cells(1, "A"), Cells(1, LastCol))
ThisWsName = ActiveSheet.Name

RowCount = 2
Firstrow = RowCount
Do While Cells(RowCount, "A") <> ""

If Cells(RowCount, "A") <> Cells(RowCount + 1, "A") Then

Set CopyRange = Range(Cells(Firstrow, "A"), Cells(RowCount, "A"))
NewWSName = CStr(Cells(RowCount, "A"))
Worksheets.Add After:=Sheets(ThisWsName)
ActiveSheet.Name = NewWSName
Sheets(ThisWsName).Activate
HeaderRange.Copy Destination:=Sheets(NewWSName).Range("A1")
CopyRange.EntireRow.Copy Destination:=Sheets(NewWSName).Range("A2")

Firstrow = RowCount + 1
End If

RowCount = RowCount + 1
Loop

End Sub
 
Back
Top