Copy data to new sheets
Any sheets were created? Try with the below to know at which sheetname the
error is populated.
Sub Macro()
Dim lngRef As Long
Dim lngRow As Long
Dim strRef As String
Dim lngLastRow As Long
Dim myWS1 As Worksheet
Dim myWS2 As Worksheet
On Error GoTo ErrHandler
Set myWS1 = ActiveSheet
lngLastRow = myWS1.Cells(Rows.Count, "D").End(xlUp).Row
For lngRow = 1 To lngLastRow
If strRef < "" And myWS1.Range("AC" & lngRow) < strRef Then
Set myWS2 = Sheets.Add(After:=myWS1)
myWS2.Name = myWS1.Range("D" & lngRow - 1)
myWS1.Range("A" & lngRef, "AC" & lngRow - 1).Copy myWS2.Range("A1")
strRef = Range("A" & lngRow)
lngRef = lngRow
End If
If strRef = "" Then strRef = myWS1.Range("AC" & lngRow): lngRef = lngRow
Next
Set myWS2 = Sheets.Add(After:=myWS1)
myWS2.Name = myWS1.Range("D" & lngRow - 1)
myWS1.Range("A" & lngRef, "AC" & lngRow - 1).Copy myWS2.Range("A1")
myWS1.Activate
ErrHandler:
MsgBox "Sheet name:" & Range("D" & lngRow - 1),,"Row:" & lngRow
End Sub
--
If this post helps click Yes
---------------
Jacob Skaria
"Sverre" wrote:
Thank you Jacob.
Debugging:
The program stopps at this statement:
myWS2.Name = myWS1.Range("D" & lngRow - 1)
|