Create new book..paste data..save..close
 

Hi all
Code below

Trying to create a new workbook paste some data to the new book
save and close.

Debug comes back here :

'===============================================
With wsSummary
Set cRange = .Application.Workbooks("lsr_template.xls") _
.Worksheets("Summary").Range("C2:G" & lngRows)
End With
'===============================================

I've tried a couple variations on this
Keeps bombing on me.

Thanks much
-goss

Full Code:

Sub lsr_WriteItOut()
'Get_Rows is UDF
'Globals: wbBook, wsData, wsFormulas, wsHeader, rnFormula

Dim wsSummary As Worksheet
Dim cellRef As Variant
Dim wbNew As Workbook
Dim newRange As Range
Dim cRange As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Set wbBook = ThisWorkbook

With wbBook
Set wsSummary = .Worksheets("Summary")
End With

With wsSummary
cellRef = .Range("H2").Value
End With

Set wbNew = Application.Workbooks.Add

With wbNew
.SaveAs "c:\lsr\lsr" & cellRef & ".xls"
.Sheets("Sheet1").Name = "Data"
End With

With wsSummary
Set cRange = .Application.Workbooks("lsr_template.xls") _
.Worksheets("Summary").Range("C2:G" & lngRows)
End With

With wbNew
Set newRange = .Application.Workbooks _
("lsr" & cellRef & ".xls") _
.Worksheets("Data").Range("A1")
End With

newRange.Value = cRange.Value

With wbNew
.Save
.Close
End With

'Clean Up / Reset
Set wbBook = Nothing
Set wbNew = Nothing
Set cRange = Nothing
Set newRange = Nothing

Set wsSummary = Nothing
Set copyfrRange = Nothing
Set copytoRange = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True

End Sub

Create new book..paste data..save..close
 

Because you have already set wsSummary you should be able to use just:

With wsSummary
Set cRange = .Range("C2:G" & lngRows)
End With

However you haven't set lngRows. You need to set lngRows first otherwise
it is 0 and this will cause an error.

Hope this helps
Rowan

wrote:
Hi all
Code below

Trying to create a new workbook paste some data to the new book
save and close.

Debug comes back here :

'===============================================
With wsSummary
Set cRange = .Application.Workbooks("lsr_template.xls") _
.Worksheets("Summary").Range("C2:G" & lngRows)
End With
'===============================================

I've tried a couple variations on this
Keeps bombing on me.

Thanks much
-goss

Full Code:

Sub lsr_WriteItOut()
'Get_Rows is UDF
'Globals: wbBook, wsData, wsFormulas, wsHeader, rnFormula

Dim wsSummary As Worksheet
Dim cellRef As Variant
Dim wbNew As Workbook
Dim newRange As Range
Dim cRange As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Set wbBook = ThisWorkbook

With wbBook
Set wsSummary = .Worksheets("Summary")
End With

With wsSummary
cellRef = .Range("H2").Value
End With

Set wbNew = Application.Workbooks.Add

With wbNew
.SaveAs "c:\lsr\lsr" & cellRef & ".xls"
.Sheets("Sheet1").Name = "Data"
End With

With wsSummary
Set cRange = .Application.Workbooks("lsr_template.xls") _
.Worksheets("Summary").Range("C2:G" & lngRows)
End With

With wbNew
Set newRange = .Application.Workbooks _
("lsr" & cellRef & ".xls") _
.Worksheets("Data").Range("A1")
End With

newRange.Value = cRange.Value

With wbNew
.Save
.Close
End With

'Clean Up / Reset
Set wbBook = Nothing
Set wbNew = Nothing
Set cRange = Nothing
Set newRange = Nothing

Set wsSummary = Nothing
Set copyfrRange = Nothing
Set copytoRange = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True

End Sub