Hi Everyone,
Currently I have an excel with hundreds of rows, I have to group the rows by the number indicated in column A. For the rows with the same indicator in column A, I would like to copy them into a new worksheet, rename the new worksheet with the indicator.
Here is the code I have made but doesn't work well. Could anyone please help to check? Million Thanks.
Sub grouping()
'
'check length of worksheet
Dim i As Integer
i = 1
Range("A1").Select
Do While (Cells(i, 1).Value <> "")
i = i + 1
Loop
i = i - 1
'column width adjustment
Columns("A:A").ColumnWidth = 10
Range("N:T").EntireColumn.AutoFit
'hide useless columns
Columns("B:M").EntireColumn.Hidden = True
'Consolidation of the worksheet by column A indicator
Dim j As Integer
j = 2
Range("A2").Select
Do
Do While (Cells(j, 1).Value = Cells(j + 1, 1).Value)
j = j + 1
Loop
'Consolidation of the worksheet by column M (which is date) indicator
Dim K As Integer
K = j
Do While (Cells(K, 13).Value = Cells(K - 1, 13).Value)
K = K - 1
Loop
'first row
If j = K And j = 2 Then
With ActiveSheet.XXXXXXXXXX (May I know how can I change the printarea to selection area?, I would like to copy and paste the selection area to new worksheet instead of print it out )
.PrintArea = "$A$1:" & "$T$" & K
'.LeftMargin = Application.InchesToPoints(0.3)
'.RightMargin = Application.InchesToPoints(0.3)
'.Zoom = False
'.FitToPagesWide = 1
'.FitToPagesTall = False
'.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
Rows(K).EntireRow.Hidden = True
Else
Rows("2:" & K - 1).EntireRow.Hidden = True
With ActiveSheet.PageSetup
.PrintArea = "$A$1:" & "$T$" & j (Same Issue as above
)
'.LeftMargin = Application.InchesToPoints(0.3)
'.RightMargin = Application.InchesToPoints(0.3)
'.Zoom = False
'.FitToPagesWide = 1
'.FitToPagesTall = False
'.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
Rows("2:" & j).EntireRow.Hidden = True
End If
j = j + 1
Loop Until j > i
End Sub
Currently I have an excel with hundreds of rows, I have to group the rows by the number indicated in column A. For the rows with the same indicator in column A, I would like to copy them into a new worksheet, rename the new worksheet with the indicator.
Here is the code I have made but doesn't work well. Could anyone please help to check? Million Thanks.
Sub grouping()
'
'check length of worksheet
Dim i As Integer
i = 1
Range("A1").Select
Do While (Cells(i, 1).Value <> "")
i = i + 1
Loop
i = i - 1
'column width adjustment
Columns("A:A").ColumnWidth = 10
Range("N:T").EntireColumn.AutoFit
'hide useless columns
Columns("B:M").EntireColumn.Hidden = True
'Consolidation of the worksheet by column A indicator
Dim j As Integer
j = 2
Range("A2").Select
Do
Do While (Cells(j, 1).Value = Cells(j + 1, 1).Value)
j = j + 1
Loop
'Consolidation of the worksheet by column M (which is date) indicator
Dim K As Integer
K = j
Do While (Cells(K, 13).Value = Cells(K - 1, 13).Value)
K = K - 1
Loop
'first row
If j = K And j = 2 Then
With ActiveSheet.XXXXXXXXXX (May I know how can I change the printarea to selection area?, I would like to copy and paste the selection area to new worksheet instead of print it out )
.PrintArea = "$A$1:" & "$T$" & K
'.LeftMargin = Application.InchesToPoints(0.3)
'.RightMargin = Application.InchesToPoints(0.3)
'.Zoom = False
'.FitToPagesWide = 1
'.FitToPagesTall = False
'.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
Rows(K).EntireRow.Hidden = True
Else
Rows("2:" & K - 1).EntireRow.Hidden = True
With ActiveSheet.PageSetup
.PrintArea = "$A$1:" & "$T$" & j (Same Issue as above
)'.LeftMargin = Application.InchesToPoints(0.3)
'.RightMargin = Application.InchesToPoints(0.3)
'.Zoom = False
'.FitToPagesWide = 1
'.FitToPagesTall = False
'.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
Rows("2:" & j).EntireRow.Hidden = True
End If
j = j + 1
Loop Until j > i
End Sub