Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Worksheet Functions > Please how do do this in vba
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Steved
 
Posts: n/a
Default Please how do do this in vba
Hello from Steved

I have sheet1 labeled Data, Where the below is stored

I've Labeled 8 Sheets as an example 1-City, 2-Roskill
and so on. Question in vba please could somebody please
write me a code that would copy from the Data Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value Total, Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511

Reply With QuoteReply With Quote
  #2   Report Post  
Bob Phillips
 
Posts: n/a
Default
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - 1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow - iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - 1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in message
...
Hello from Steved

I have sheet1 labeled Data, Where the below is stored

I've Labeled 8 Sheets as an example 1-City, 2-Roskill
and so on. Question in vba please could somebody please
write me a code that would copy from the Data Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value Total, Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



Reply With QuoteReply With Quote
  #3   Report Post  
Steved
 
Posts: n/a
Default
Hello from Steved

Firstly thankyou very much

The macro is highlighting "Else"

giving me Compile error, ELSE without IF

Please what is required here. Thanks very much in advance.

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow -
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i -
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub







-----Original Message-----
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow -
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - 1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in
message
...
Hello from Steved

I have sheet1 labeled Data, Where the below is stored

I've Labeled 8 Sheets as an example 1-City, 2-Roskill
and so on. Question in vba please could somebody please
write me a code that would copy from the Data Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value Total,
Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



.

Reply With QuoteReply With Quote
  #4   Report Post  
Bob Phillips
 
Posts: n/a
Default
Probably wrap-around in the NG Steved.

Try this split version

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow - _
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in message
...
Hello from Steved

Firstly thankyou very much

The macro is highlighting "Else"

giving me Compile error, ELSE without IF

Please what is required here. Thanks very much in advance.

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow -
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i -
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub







-----Original Message-----
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow -
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - 1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in
message
...
Hello from Steved

I have sheet1 labeled Data, Where the below is stored

I've Labeled 8 Sheets as an example 1-City, 2-Roskill
and so on. Question in vba please could somebody please
write me a code that would copy from the Data Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value Total,
Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



.



Reply With QuoteReply With Quote
  #5   Report Post  
Bob Phillips
 
Posts: n/a
Default
Sorry, correction

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow - _
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Bob Phillips" wrote in message
...
Probably wrap-around in the NG Steved.

Try this split version

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow - _
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in message
...
Hello from Steved

Firstly thankyou very much

The macro is highlighting "Else"

giving me Compile error, ELSE without IF

Please what is required here. Thanks very much in advance.

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow -
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i -
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub







-----Original Message-----
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow -
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - 1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in
message
...
Hello from Steved

I have sheet1 labeled Data, Where the below is stored

I've Labeled 8 Sheets as an example 1-City, 2-Roskill
and so on. Question in vba please could somebody please
write me a code that would copy from the Data Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value Total,
Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



.





Reply With QuoteReply With Quote
  #6   Report Post  
Steved
 
Posts: n/a
Default
Hello Bob from Steved

Bob firstly thankyou

I am getting the same error ELSE

Compile error:
Else without IF

Thankyou.

-----Original Message-----
Probably wrap-around in the NG Steved.

Try this split version

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow - _
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in
message
...
Hello from Steved

Firstly thankyou very much

The macro is highlighting "Else"

giving me Compile error, ELSE without IF

Please what is required here. Thanks very much in
advance.

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow -
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i -
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub







-----Original Message-----
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i -
1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved" wrote in
message
...
Hello from Steved

I have sheet1 labeled Data, Where the below is stored

I've Labeled 8 Sheets as an example 1-City, 2-Roskill
and so on. Question in vba please could somebody
please
write me a code that would copy from the Data Sheet
to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value Total,
Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



.



.

Reply With QuoteReply With Quote
  #7   Report Post  
Steved
 
Posts: n/a
Default
Hello Bob from Steved

I am getting Subscript out of Range.

Thanks for your patience.


-----Original Message-----
Sorry, correction

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow - _
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Bob Phillips" wrote
in message
...
Probably wrap-around in the NG Steved.

Try this split version

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow -
_
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved" wrote in
message
...
Hello from Steved

Firstly thankyou very much

The macro is highlighting "Else"

giving me Compile error, ELSE without IF

Please what is required here. Thanks very much in
advance.

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i -
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub







-----Original Message-----
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i - 1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved" wrote
in
message
...
Hello from Steved

I have sheet1 labeled Data, Where the below is
stored

I've Labeled 8 Sheets as an example 1-City, 2-
Roskill
and so on. Question in vba please could somebody
please
write me a code that would copy from the Data
Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value Total,
Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



.





.

Reply With QuoteReply With Quote
  #8   Report Post  
Bob Phillips
 
Posts: n/a
Default
Is your data sheet called something other than 'Data Sheet'?

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in message
...
Hello Bob from Steved

I am getting Subscript out of Range.

Thanks for your patience.


-----Original Message-----
Sorry, correction

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow - _
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Bob Phillips" wrote
in message
...
Probably wrap-around in the NG Steved.

Try this split version

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize(iLastRow -
_
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved" wrote in
message
...
Hello from Steved

Firstly thankyou very much

The macro is highlighting "Else"

giving me Compile error, ELSE without IF

Please what is required here. Thanks very much in
advance.

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i -
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub







-----Original Message-----
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i - 1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved" wrote
in
message
...
Hello from Steved

I have sheet1 labeled Data, Where the below is
stored

I've Labeled 8 Sheets as an example 1-City, 2-
Roskill
and so on. Question in vba please could somebody
please
write me a code that would copy from the Data
Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value Total,
Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



.





.



Reply With QuoteReply With Quote
  #9   Report Post  
Steved
 
Posts: n/a
Default
Thankyou, I am Sorry I was not thinking

The sheet is Data I've changed it from Data Sheet
to Data

Question I would like to put in headings in Row 1
Would that be okay

Thankyou again for your patience.


-----Original Message-----
Is your data sheet called something other than 'Data
Sheet'?

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in
message
...
Hello Bob from Steved

I am getting Subscript out of Range.

Thanks for your patience.


-----Original Message-----
Sorry, correction

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow - _
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i -
_
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Bob Phillips"
wrote
in message
...
Probably wrap-around in the NG Steved.

Try this split version

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
_
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved" wrote
in
message
...
Hello from Steved

Firstly thankyou very much

The macro is highlighting "Else"

giving me Compile error, ELSE without IF

Please what is required here. Thanks very much in
advance.

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i -
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub







-----Original Message-----
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i - 1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved"
wrote
in
message
...
Hello from Steved

I have sheet1 labeled Data, Where the below is
stored

I've Labeled 8 Sheets as an example 1-City, 2-
Roskill
and so on. Question in vba please could somebody
please
write me a code that would copy from the Data
Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value
Total,
Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



.





.



.

Reply With QuoteReply With Quote
  #10   Report Post  
Bob Phillips
 
Posts: n/a
Default
Does your data sheet have the headings that you want copy across, or do we
create them on the fly?

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in message
...
Thankyou, I am Sorry I was not thinking

The sheet is Data I've changed it from Data Sheet
to Data

Question I would like to put in headings in Row 1
Would that be okay

Thankyou again for your patience.


-----Original Message-----
Is your data sheet called something other than 'Data
Sheet'?

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in
message
...
Hello Bob from Steved

I am getting Subscript out of Range.

Thanks for your patience.


-----Original Message-----
Sorry, correction

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow - _
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i -
_
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Bob Phillips"
wrote
in message
...
Probably wrap-around in the NG Steved.

Try this split version

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
_
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved" wrote
in
message
...
Hello from Steved

Firstly thankyou very much

The macro is highlighting "Else"

giving me Compile error, ELSE without IF

Please what is required here. Thanks very much in
advance.

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i -
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub







-----Original Message-----
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i - 1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved"
wrote
in
message
...
Hello from Steved

I have sheet1 labeled Data, Where the below is
stored

I've Labeled 8 Sheets as an example 1-City, 2-
Roskill
and so on. Question in vba please could somebody
please
write me a code that would copy from the Data
Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value
Total,
Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



.





.



.



Reply With QuoteReply With Quote
  #11   Report Post  
Steved
 
Posts: n/a
Default
Hello again

Data sheet has headings I would like to copy across please.

Thankyou.

-----Original Message-----
Does your data sheet have the headings that you want copy
across, or do we create them on the fly?

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in
message
...
Thankyou, I am Sorry I was not thinking

The sheet is Data I've changed it from Data Sheet
to Data

Question I would like to put in headings in Row 1
Would that be okay

Thankyou again for your patience.


-----Original Message-----
Is your data sheet called something other than 'Data
Sheet'?

--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved" wrote in
message
...
Hello Bob from Steved

I am getting Subscript out of Range.

Thanks for your patience.


-----Original Message-----
Sorry, correction

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow - _
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i -
_
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Bob Phillips"
wrote
in message
...
Probably wrap-around in the NG Steved.

Try this split version

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then iLastRow = i -
1
.Cells(iStartRow, "A").Resize
(iLastRow -
_
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved"
wrote
in
message
...
Hello from Steved

Firstly thankyou very much

The macro is highlighting "Else"

giving me Compile error, ELSE without IF

Please what is required here. Thanks very much
in
advance.

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets
(.Cells
(i -
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub







-----Original Message-----
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells
(i -
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets
(.Cells
(i - 1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if
mailing
direct)


"Steved"
wrote
in
message
...
Hello from Steved

I have sheet1 labeled Data, Where the below
is
stored

I've Labeled 8 Sheets as an example 1-City,
2-
Roskill
and so on. Question in vba please could
somebody
please
write me a code that would copy from the Data
Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value
Total,
Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



.





.



.



.

Reply With QuoteReply With Quote
  #12   Report Post  
Bob Phillips
 
Posts: n/a
Default
Here you go mate

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 3 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then
iLastRow = i - 1
.Cells(1, "A").EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A1")
.Cells(iStartRow, "A").Resize(iLastRow - _
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A2")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in message
...
Thankyou, I am Sorry I was not thinking

The sheet is Data I've changed it from Data Sheet
to Data

Question I would like to put in headings in Row 1
Would that be okay

Thankyou again for your patience.


-----Original Message-----
Is your data sheet called something other than 'Data
Sheet'?

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in
message
...
Hello Bob from Steved

I am getting Subscript out of Range.

Thanks for your patience.


-----Original Message-----
Sorry, correction

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow - _
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i -
_
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Bob Phillips"
wrote
in message
...
Probably wrap-around in the NG Steved.

Try this split version

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
_
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved" wrote
in
message
...
Hello from Steved

Firstly thankyou very much

The macro is highlighting "Else"

giving me Compile error, ELSE without IF

Please what is required here. Thanks very much in
advance.

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i -
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub







-----Original Message-----
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i - 1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved"
wrote
in
message
...
Hello from Steved

I have sheet1 labeled Data, Where the below is
stored

I've Labeled 8 Sheets as an example 1-City, 2-
Roskill
and so on. Question in vba please could somebody
please
write me a code that would copy from the Data
Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value
Total,
Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



.





.



.



Reply With QuoteReply With Quote
  #13   Report Post  
Steved
 
Posts: n/a
Default
Very kind thankyou.
-----Original Message-----
Here you go mate

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data")
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 3 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then
iLastRow = i - 1
.Cells(1, "A").EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A1")
.Cells(iStartRow, "A").Resize(iLastRow - _
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets(.Cells(i - _
1, "A").Value).Range("A2")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Steved" wrote in
message
...
Thankyou, I am Sorry I was not thinking

The sheet is Data I've changed it from Data Sheet
to Data

Question I would like to put in headings in Row 1
Would that be okay

Thankyou again for your patience.


-----Original Message-----
Is your data sheet called something other than 'Data
Sheet'?

--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved" wrote in
message
...
Hello Bob from Steved

I am getting Subscript out of Range.

Thanks for your patience.


-----Original Message-----
Sorry, correction

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow - _
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i -
_
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Bob Phillips"
wrote
in message
...
Probably wrap-around in the NG Steved.

Try this split version

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i - _
1, "A").Value Then iLastRow = i -
1
.Cells(iStartRow, "A").Resize
(iLastRow -
_
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets(.Cells
(i - _
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing
direct)


"Steved"
wrote
in
message
...
Hello from Steved

Firstly thankyou very much

The macro is highlighting "Else"

giving me Compile error, ELSE without IF

Please what is required here. Thanks very much
in
advance.

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells(i -
1, "A").Value Then iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow + 1).EntireRow.Copy _
Destination:=Worksheets
(.Cells
(i -
1, "A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub







-----Original Message-----
Steved,

This assumes that all of those worksheets exist

Sub Test()
Dim cLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iLastRow As Long

With Worksheets("Data Sheet")
cLastRow = .Cells(.Rows.Count, "A").End
(xlUp).Row
iStartRow = 1
iLastRow = 1
For i = 2 To cLastRow + 1
If .Cells(i, "A").Value < Cells
(i -
1, "A").Value Then
iLastRow = i - 1
.Cells(iStartRow, "A").Resize
(iLastRow -
iStartRow +
1).EntireRow.Copy _
Destination:=Worksheets
(.Cells
(i - 1,
"A").Value).Range("A1")
iStartRow = i
iLastRow = i
Else
iLastRow = iLastRow + 1
End If
Next i
End With

End Sub


--

HTH

RP
(remove nothere from the email address if
mailing
direct)


"Steved"
wrote
in
message
...
Hello from Steved

I have sheet1 labeled Data, Where the below
is
stored

I've Labeled 8 Sheets as an example 1-City,
2-
Roskill
and so on. Question in vba please could
somebody
please
write me a code that would copy from the Data
Sheet to
the 8 individual labeled sheets. Thankyou.

Depot,Name Operator,Count Annuls,Annul Value
Total,
Period
1-City 10925 27 29.60 200511
1-City 10943 27 54.90 200511
6-Orewa 60124 28 67.44 200511
6-Orewa 60123 17 42.10 200511
8-Panmure 10903 27 54.04 200511
8-Panmure 10915 27 45.80 200511
3-Papakura 86076 48 122.70 200511
3-Papakura 86030 30 69.54 200511
2-Roskill 20824 42 35.38 200511
2-Roskill 20751 36 83.30 200511
5-Shore 50636 40 82.60 200511
5-Shore 50600 34 104.80 200511
7-Swanson 70468 40 59.94 200511
7-Swanson 70478 39 109.50 200511
4-Wiri 40677 35 64.40 200511
4-Wiri 40662 28 58.00 200511



.





.



.



.

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


All times are GMT +1. The time now is 04:15 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement