I am trying to create a loop to copy data in cells in source worksheet one by one and paste in a particular cell in target worksheet. Once the cell is pasted, i need it to save a copy of the file then paste the next value in the source worksheet.The code is:
Private Sub CommandButton1_Click()
Dim wbTarget As Worksheet
Dim wbSource As Worksheet
Dim SaveLoc As String
Dim FName As String
Dim i As Long
Set wbSource = Sheets("Sheet3")
Set wbTarget = Sheets("Sheet1")
wbSource.Activate
Range("A1").Activate
Do While ActiveCell.Value <> ""
DoEvents
ActiveCell.Copy
For i = 1 To 30
wbTarget.Activate
With ActiveSheet
wbTarget.Range("E5").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths
Selection.PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Save
Application.CutCopyMode = False
End With
SaveLoc = "H:\Services\Test Output\Term_"
FName = Range("B5")
ActiveWorkbook.SaveCopyAs FileName:=SaveLoc & FName & ".xls" 'FileFormat:=xlNormal
Application.DisplayAlerts = False
Next i
wbSource.Select
ActiveCell.Offset(1, 0).Activate
Loop
Application.ScreenUpdating = True
End Sub
When I run this, I get a
run-time error 1004.
Please advise on how to resolve this.
Thank You in Advance.