macro help please

[MonkeyMe]

hi, i need some help writing a macro that cuts and pastes some rows into
a new sheet and saves it accordingly to a cell name.

e.g.

Repeating
Vendor ID
Number 1
total: $15

Repeating
Vendor ID
Number 2
total $20



so "Repeating" is the marker and i need it to take that certain chunk
and save it as the "Vendor ID" name so the first one would be named
"Number 1.xls"

thanks for the help!

 

[Bob Phillips]

Sub test()
Dim oThis As Worksheet
Dim oWB As Workbook
Dim iLastRow As Long
Dim iStart As Long
Dim i As Long

Set oThis = ActiveSheet
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
If Cells(i, "A").Value = "Repeating" Then
If iStart > 0 Then
Set oWB = Workbooks.Add
oThis.Range("A" & iStart & ":A" & i - 1).Copy
oWB.Worksheets(1).Range("A1")
oWB.SaveAs oThis.Cells(iStart + 2, "A") & ".xls"
End If
iStart = i
End If
Next i

End Sub

 

[MonkeyMe]

hi, thanks for the quick reply!

but i get the error:
Run-time error '438'
Object doesn't support this property or method

do i have to enable something somewhere?

 

[Bob Phillips]

That was probably a wrap-around problem. Try this version

Sub test()
Dim oThis As Worksheet
Dim oWB As Workbook
Dim iLastRow As Long
Dim iStart As Long
Dim i As Long

Set oThis = ActiveSheet
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
If Cells(i, "A").Value = "Repeating" Then
If iStart > 0 Then
Set oWB = Workbooks.Add
oThis.Range("A" & iStart & ":A" & i - 1).Copy _
oWB.Worksheets(1).Range("A1")
oWB.SaveAs oThis.Cells(iStart + 2, "A") & ".xls"
End If
iStart = i
End If
Next i

End Sub

 

[MonkeyMe]

thanks for the quick reply again
but now i get another error:
Run-time error '1004'
Method 'SaveAs' of object '_workbook' faile

 

[MonkeyMe]

hey, thanks i fixed the problem. but its not looping through the whol
worksheet picking off each sectio

 

[Bob Phillips]

What exactly do you mean, and how did you solve the previous problem?