VBA Loop to change value from a Cell

[12Rev79]

Dear Expert.

I have a file "Extract.xlsx" in the sheetname "voucher" with a list of voucher number as below
Column D2
CEGS-XS-AF-1370
CEGS-XS-AF-1375
CEGS-XS-AF-1401

The code below will open this file "Key support_DIV-CEGS-XS-AF-Fabrication.xlsx"
and rename base on the listed in Column D and change the Value of in Cell A5 base also in Column D

The code below works but in cell A5 it only write the value of the first voucher in Column D
I want that each file should be have the filanename base in listed in Column D2 up to the last and change the value Cell A5 each for listed voucher in Column D

Please may be someone is kind to help me figure out how to modify the code below.

Thanks in advance

Sub Macro1()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim ws As Worksheet, KeyW As Workbook, KeyS As Worksheet, ls As Long, i As Integer
Dim path As String, keypath As String

path = "C:\Desktop\Fabrication"
keypath = "Key support_DIV-CEGS-XS-AF-Fabrication.xlsx"

Set ws = ThisWorkbook.Sheets(1)
ls = ws.Cells(Rows.Count, "D").End(xlUp).Row
Set KeyW = Workbooks.Open(path & "\" & keypath)

Set KeyS = KeyW.Sheets(1)
For i = 2 To Application.CountA(ws.Range("D2:D" & ls))+1
With KeyS
.Range("A5").Value = Mid(ws.Range("D2").Value, 5, 20)
KeyW.SaveCopyAs path & "\" & "Key support_" & ws.Range("D" & i).Value & ".xlsx"

End With

Next i
KeyW.Close False 'Close file "Key support_DIV-CEGS-XS-AF-Fabrication.xlsx"

MsgBox "Done"

End Sub

 

[offthelip]

I think you need to change this line:

.Range("A5").Value = Mid(ws.Range("D2").Value, 5, 20)

to

.Range("A5").Value = Mid(ws.Range("D" & i).Value, 5, 20)

Note: Please use the code formating for your code it does make it easier to read

 

[12Rev79]

I think you need to change this line:

.Range("A5").Value = Mid(ws.Range("D2").Value, 5, 20)

to

.Range("A5").Value = Mid(ws.Range("D" & i).Value, 5, 20)

Note: Please use the code formating for your code it does make it easier to read

Dear offthelip thanks for the help, I appreciate so much it works will.
Noted, in my next post if any I will be using the Code formatting.

Thanks again offthelip and God Bless!