G
goss9394
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
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