Acronym Macro
Sub Sort_Acronyms()
With Sheets("sheet1")
Set ShortSht = Worksheets.Add(after:=Sheets(Sheets.Count))
ShortSht.Name = "Sort Data"
.Range("A2:L30").Copy Destination:=ShortSht.Range("A1")
End With
With ShortSht
.Range("A1:L29").Sort _
Key1:=Range("F1"), _
Header:=xlNo
RowCount = 1
FirstRow = RowCount
Do While RowCount <= 30
If .Range("F" & RowCount) < .Range("F" & (RowCount + 1)) Then
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = .Range("F" & RowCount)
.Rows(FirstRow & ":" & RowCount).Copy _
Destination:=NewSht.Rows(1)
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop
End With
End Sub
"ytayta555" wrote:
1. Copy the entire contents of rows in Sheet 1 from A2 to L30.
Copy the entire contents of rows in Sheet 1 from which Sheet ?
|