- Joined
- May 16, 2008
- Messages
- 1
- Reaction score
- 0
Hi,
I have written the below code to copy data from one sheet and insert into a new template however when i get to Activesheet.paste the data disappears and doesnt paste in the new sheet. Any advise would be great as this has been killing my brain for days, the new sheet is not read only so i cant see issues with it, maybe its something to do with my earlier coding but im not qualified enough to find the break. The data is 100 rows long and 7 columns wide and should seperate by account number and paste into a new sheet and save and perform the loop on all data.
Your help is greatly appreciated.
Thanks, Joe
Sub Macro1()
'
Dim strThisCC As String, strDirectoryToUse As String
Range("A2").Select
strDirectoryToUse = Application.GetSaveAsFilename
Do While True
strThisCC = ActiveCell.Value
If strThisCC = "" Then Exit Sub
Call SaveNextSheet
Loop
End Sub
Sub SaveNextSheet()
Dim strThisCC As String, strSheetName As String
strThisCC = ActiveCell.Value
strSheetName = ""
Do While ActiveCell.Value = strThisCC
strThisCC = ActiveCell.Value
ActiveSheet.Cells(ActiveCell.Row + 1, 1).Select
'MsgBox "This Cost Centre = " & ActiveCell.Value & vbCr & "Current Row = " & ActiveCell.Row
Loop
strSheetName = strThisCC & "_file.xls"
ActiveWorkbook.Names.Add Name:="MyName", RefersTo:=ActiveCell()
Selection.EntireRow.Insert
ActiveSheet.Cells(ActiveCell.Row - 1, 1).Select
Selection.CurrentRegion.Select
Selection.Copy
Workbooks.Add Template:= _
"F:\Home\template.xls"
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=strSheetName, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close
Application.Goto Reference:="MyName"
Exit Sub
End Sub
I have written the below code to copy data from one sheet and insert into a new template however when i get to Activesheet.paste the data disappears and doesnt paste in the new sheet. Any advise would be great as this has been killing my brain for days, the new sheet is not read only so i cant see issues with it, maybe its something to do with my earlier coding but im not qualified enough to find the break. The data is 100 rows long and 7 columns wide and should seperate by account number and paste into a new sheet and save and perform the loop on all data.
Your help is greatly appreciated.
Thanks, Joe
Sub Macro1()
'
Dim strThisCC As String, strDirectoryToUse As String
Range("A2").Select
strDirectoryToUse = Application.GetSaveAsFilename
Do While True
strThisCC = ActiveCell.Value
If strThisCC = "" Then Exit Sub
Call SaveNextSheet
Loop
End Sub
Sub SaveNextSheet()
Dim strThisCC As String, strSheetName As String
strThisCC = ActiveCell.Value
strSheetName = ""
Do While ActiveCell.Value = strThisCC
strThisCC = ActiveCell.Value
ActiveSheet.Cells(ActiveCell.Row + 1, 1).Select
'MsgBox "This Cost Centre = " & ActiveCell.Value & vbCr & "Current Row = " & ActiveCell.Row
Loop
strSheetName = strThisCC & "_file.xls"
ActiveWorkbook.Names.Add Name:="MyName", RefersTo:=ActiveCell()
Selection.EntireRow.Insert
ActiveSheet.Cells(ActiveCell.Row - 1, 1).Select
Selection.CurrentRegion.Select
Selection.Copy
Workbooks.Add Template:= _
"F:\Home\template.xls"
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=strSheetName, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close
Application.Goto Reference:="MyName"
Exit Sub
End Sub