Copy Each Cell in Range on one worksheet to cell in another worksheet data updates save copy of workbook repeat through first range

[mjb342]

Hi All,

I have a range of "Id's" in one worksheet (A4:A18) that I'd like to loop through and copy each and paste the values into cell G4 of another worksheet. The cells on that worksheet would then update based on the new ID. From there I want to save a copy of the workbook that will include that ID and the cell above it which is a name. Super new but eager to keep learning.

Sub Save_Copy_File()
Dim ID As Range
Dim srcWS As Worksheet
Dim LastRow As Long
Dim Filename As String
Dim Path As String


Application.ScreenUpdating = False
Path = "\\this is where i want the file saved"
Set Filename = Worksheets("TP").Range("G3").Value
Set srcWS = Sheets("TD")
LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For Each ID In srcWS.Range("A4:A18")
Sheets("TD").Range("A4").Copy
Sheets("TP").Range("G4").PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.SaveCopyAs Filename:=Path & ID & "_" & Filename & "_4.30.20 FYE Pro" & ".xlsm"
Next ID
Application.ScreenUpdating = True

End Sub

 

[DanteAmor]

How about

Sub Save_Copy_File()
  Dim c As Range, sPath As String, sName As String
  Application.ScreenUpdating = False
  '
  sPath = "C:\trabajo\"
  sName = Worksheets("TP").Range("G3").Value
  '
  For Each c In Sheets("TD").Range("A4:A18")
    Sheets("TP").Range("G4").Value = c.Value
    ActiveWorkbook.SaveCopyAs Filename:=sPath & c.Value & "_" & sName & "_4.30.20 FYE Pro" & ".xlsm"
  Next c
  Application.ScreenUpdating = True
End Sub

 

[mjb342]

That worked well. Only remaining issue is that it's saving each file as the name of the first file. In other words G3 gets updated in the file when G4 changes it's just that the filename doesn't pick that up. The ID changes for each workbook that's saved.

 

[DanteAmor]

Try this

Sub Save_Copy_File()
  Dim c As Range, sPath As String, sName As String
  Application.ScreenUpdating = False
  '
  sPath = "C:\trabajo\"
   For Each c In Sheets("TD").Range("A4:A18")
    Sheets("TP").Range("G4").Value = c.Value
    sName = Sheets("TP").Range("G3").Value 
   ActiveWorkbook.SaveCopyAs Filename:=sPath & c.Value & "_" & sName & "_4.30.20 FYE Pro" & ".xlsm"
  Next c
  Application.ScreenUpdating = True
End Sub

 

[mjb342]

Dante,

This worked perfectly. Appreciate the help.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.