I am a realative beginner at VB coding, but am trying to piece together something to save me some time. I have a large list of data that I would like to sort based off of the information in Column A (an ID number containing both letters and numbers) and have the macro create a worksheet for each ID Number then proceed to paste all entries (rows) on the master sheet to it's respectively created worksheet. I've succeeded in creating the worksheets, but am having issues with getting the code that will paste the code to the respective worksheet. Here is what I have so far:
Sub Macro2()
Dim lastRow, IDnumber, tstValue1, tstValue2, shtName, Nm
On Error Resume Next
'Make a copy of the data sheet and sort by ID#
Sheets("Sheet1").Copy After:=Sheets(1)
Sheets(2).Name = "SortTemp"
With Sheets("SortTemp")
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Rows("2:" & lastRow).Sort Key1:=Range("A2"), Order1:=xlAscending
'Using SortTemp Sheet, create individual sheets by
'testing ID values in Column A
'Loop through ID's
For Each IDnumber In .Range("A2:A" & lastRow)
tstDate1 = IDnumber
tstDate2 = IDnumber.Offset(-1, 0)
'If ID Numbers are different than cell above, create new sheet
If tstDate1 <> tstDate2 Then
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
'Name the sheet based on the ID number
ActiveSheet.Name = IDnumber
End If
Next
On Error GoTo 0
Sheets("SortTemp").Select
'Loop through ID Numbers, copying row to correct sheet
For Each Nm In .Range("A2:A" & lastRow)
'Create sheetname variable
shtName = Nm
'Find the first open row
nxtRow = Sheets(shtName).Cells.Find("*", Searchorder:=xlByRows, SearchDirection:=xlPrevious).Row
'Copy Data
.Range(A2:A, lastRow).EntireRow.Copy Destination:=Sheets(shtName).Cells(nxtRow, 1)
Next
End With
'Delete SortTemp sheet
Application.DisplayAlerts = False
Sheets("SortTemp").Delete
Application.DisplayAlerts = True
End Sub
I've attached a file with a shortened Data Set I have been testing on, any assistance would be most appreciated.
Bookmarks