Paste Data to New Workbook

[phatmankerrcap]

Created the following script (from help and some helpful web sites).

But there is an error when trying to paste the data to a new workbook (have been messing around with it all day).

Any suggestions would be hugely appreciated.

Have highlighted in bold where I think the error is.

Many thanks

Phat

Sub Split()

Dim r1 As Range
Dim wbNew As Workbook


    With ThisWorkbook.Sheets(1)
    
    
    Set c = Cells.Find("Split:", LookIn:=xlValues, LookAt:=xlPart)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
       
         If firstaddress = c.Address Then
          Set r1 = Range(Cells(1, 1), Cells(c.Row, Columns.Count))
        
        [b]  r1.EntireRow.Copy Destination:=wbNew.Sheets(1).Range("A1")
            wbNew.Close SaveChanges:=True, Filename:=Mid(c, 8, 40)[/b]
            
            Else
            
               Set r1 = Range(Cells(d.Row + 1, 1), Cells(c.Row, Columns.Count))
               
          r1.EntireRow.Copy Destination:=wbNew.Sheets(1).Range("A1")
            wbNew.Close SaveChanges:=True, Filename:=Mid(c, 8, 40)
            
         End If
            Set d = c.Rows
            Set c = Cells.FindNext(c)
            
        Loop While Not c Is Nothing And c.Address <> firstaddress
    End If


    End With
     
     
End Sub

 

[SkipVought]

You never set the object wbNew.

You must ADD a workbook or OPEN a workbook.

For instance

Dim wbNew As Workbook

Set wbNew = Workbooks.Add

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[phatmankerrcap]

Skip,

Nice one, that got rid of the error - it now creates a new workbook, but it doesn't paste the data and then save the new workbook the script just stalls at that point.

Any ideas ?

Thanks

Phat

 

[xlbo]

pleas epost the code you are using...

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[SkipVought]

Notice the [red].[/red]red POINTS...

With ThisWorkbook.Sheets(1)
    
    
    Set c = [red][b].[/b][/red]Cells.Find("Split:", LookIn:=xlValues, LookAt:=xlPart)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
       
         If firstaddress = c.Address Then
          Set r1 = Range([red][b].[/b][/red]Cells(1, 1), [red][b].[/b][/red]Cells(c.Row, Columns.Count))
        
          r1.EntireRow.Copy Destination:=wbNew.Sheets(1).Range("A1")
            wbNew.Close SaveChanges:=True, Filename:=Mid(c, 8, 40)
            
            Else
            
               Set r1 = Range([red][b].[/b][/red]Cells(d.Row + 1, 1), [red][b].[/b][/red]Cells(c.Row, Columns.Count))
               
          r1.EntireRow.Copy Destination:=wbNew.Sheets(1).Range("A1")
            wbNew.Close SaveChanges:=True, Filename:=Mid(c, 8, 40)
            
         End If
            Set d = c.Rows
            Set c = [red][b].[/b][/red]Cells.FindNext(c)
            
        Loop While Not c Is Nothing And c.Address <> firstaddress
    End If


End With

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[PHV]

What is your actual code ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[phatmankerrcap]

Skip,

Many thanks that worked - script does exactly as expected.

Cheers

Phat

 

[SkipVought]

When you use a With...End With construct, you reference the With Object using the leading POINT

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}