Я пытаюсь открыть несколько файлов со связью между ними и сохранить их под другими именами, чтобы ссылки обновлялись там с новыми именами.Мой код открывает файлы и сохраняет их там с новыми именами, но не меняйте ссылки на новые имена.
Sub PullFromFile()
Dim wkb As Workbook, wkbFrom As Workbook, wbkto As Workbook
Dim openfile As String
Dim openPatch As String
Dim savefile As String
Dim savePatch As String
Dim openWin As String
Dim closeWin As String
Dim tbl As ListObject
Dim x As Long
Dim y As Long
Dim z As Long
Application.DisplayAlerts = False
Set wkb = ThisWorkbook
Set tbl = ActiveSheet.ListObjects("RoeeTbl")
For x = 1 To tbl.Range.Rows.Count - 1
' Get path from cell A1 on Report tab
openPatch = tbl.DataBodyRange(x, 1)
openfile = tbl.DataBodyRange(x, 2)
' Make sure there is a backslash at the end of the from path
If Right(openPatch, 1) <> "\" Then openPatch = openPatch & "\"
Set wkbFrom = Workbooks.Open(openPatch & openfile)
'set "newwkb" & x = ThisWorkbook
wkb.Activate
Next x
MsgBox ("Files Opened. Press next button to save the files in new names")
End Sub
Sub SaveTheFiles()
Dim wkb As Workbook, wkbFrom As Workbook, wbkto As Workbook
Dim openfile As String
Dim openPatch As String
Dim savefile As String
Dim savePatch As String
Dim openWin As String
Dim closeWin As String
Dim tbl As ListObject
Dim x As Long
Dim y As Long
Dim z As Long
Application.DisplayAlerts = False
Set wkb = ThisWorkbook
Set tbl = ActiveSheet.ListObjects("RoeeTbl")
For y = 1 To tbl.Range.Rows.Count - 1
openWin = tbl.DataBodyRange(y, 2)
Windows(openWin).Activate
' Get path from cell A1 on Report tab
savePatch = tbl.DataBodyRange(y, 3)
savefile = tbl.DataBodyRange(y, 4)
' Make sure there is a backslash at the end of the from path
If Right(savePatch, 1) <> "\" Then savePatch = savePatch & "\"
'save as
ActiveWorkbook.SaveAs Filename:=(savePatch & savefile), FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Next y
wkb.Activate
End Sub
Я хочу, чтобы ссылки были изменены на имена новых файлов.