View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Jacob Skaria Jacob Skaria is offline
external usenet poster
 
Posts: 8,520
Default 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)