Скопировать формулу с одного листа на другой

Question

Здравствуйте, я сейчас пытаюсь написать программу для переноса большого количества файлов Excel в другой каталог. Для этой утилиты я собрал следующие фрагменты кода. Найдите все ссылки внутри файла Excel и запишите их в другой рабочий лист в этом файле.

Sub LinkCheck_detail() 

Dim aLinks   As Variant 
Dim i    As Integer 
Dim ws    As Worksheet 
Dim anyWS   As Worksheet 
Dim anyCell   As Range 
Dim reportWS   As Worksheet 
Dim nextReportRow As Long 
Dim shtName   As String 
Dim bWsExists  As Boolean 


shtName = "Verknuepfungen_detail" 

'Löscht Datenblatt falls es bereits exisitiert. 
Sheets("Verknuepfungen_detail").Delete 

' Sheet mit den Verknuepfungen anlegen 
For Each ws In Application.Worksheets 
    If ws.Name = shtName Then bWsExists = True 
Next ws 

If bWsExists = False Then 
    Application.DisplayAlerts = False 
    Set ws = ActiveWorkbook.Worksheets.Add(Type:=xlWorksheet) 
    ws.Name = shtName 
    ws.Select 
    ws.Move After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count) 
    Application.DisplayAlerts = True 
End If 

    ' Komplettes Workbook analysieren auf Verknuepfungen 
Set reportWS = ThisWorkbook.Worksheets(shtName) 
    reportWS.Cells.Clear 
    reportWS.Range("A1") = "Sheet" 
    reportWS.Range("B1") = "Zelle" 
    reportWS.Range("C1") = "Formel" 
    reportWS.Range("A1:C1").Font.Bold = True 

    aLinks = ActiveWorkbook.LinkSources(xlExcelLinks) 
If Not IsEmpty(aLinks) Then 

     ' Wenn Verknuepfungen gefunden dann diese in Ergebnis schreiben 
     For Each anyWS In ThisWorkbook.Worksheets 
      If anyWS.Name <> reportWS.Name Then 
       For Each anyCell In anyWS.UsedRange 
        If anyCell.HasFormula Then 
         If InStr(anyCell.formula, "[") > 0 Then 
          nextReportRow = reportWS.Range("A" & Rows.Count).End(xlUp).Row + 1 
          reportWS.Range("A" & nextReportRow) = anyWS.Name 
          reportWS.Range("B" & nextReportRow) = anyCell.Address 
          reportWS.Range("C" & nextReportRow) = "'" & anyCell.formula 
         End If 
        End If 
       Next 
      End If 
     Next 
    Else 
     MsgBox "Keine Verknüpfungen gefunden in der Datei." 
    End If 

    reportWS.Columns("A:C").EntireColumn.AutoFit 
    ' Zuruecksetzen der Hilfs-Variablen 
    Set reportWS = Nothing 
    Set ws = Nothing 
End Sub 

Затем выполните изменения на пути.

Sub ReplaceEPP4_detail() 
' Author Tobias Fandrich 
' Finden von String "oldPath" in Dateipfaden und die Ersetzung durch "newPath" 
Dim ws As Worksheet 
Dim linkList As Range 
Dim linkCell As Range 


Set ws = ActiveSheet 

' Alle Eintraege selektieren 
ws.Range("c1", ActiveSheet.Range("c1").End(xlDown)).Select 

' Selektion zu Variable 
Set linkList = Selection 

' EPP4 entfernen und gegen EZE ersetzen 
linkList.Replace "oldPath", "newPath", xlPart 

End Sub 

Так это оставляет Мой с новым листом, который имеет следующие столбцы: листа, Cell, Формула

А теперь мне нужно, чтобы написать это обратно к листам, где я получил его от.

Sub UpdateLinksFormula() 

    Dim ws As Worksheet 
    Dim targetWS As String 
    Dim sourceWS As String 

    Dim sourceCell As Range 
    Dim targetCell As String 
    Dim newFormula As String 
    Dim i As Integer ' Variable fuer Sheets Count 
    Dim rowCount As Integer ' Variable fuer Rows Count 
    Dim j As Integer ' Variable fuer Schleife 
    Dim bWsExists As Boolean 

    sourceWS = "Verknuepfungen_detail" 

    ' Auf Arbeitsblatt mit Verknuepfungen springen 
    For i = 1 To Sheets.Count 
     If Sheets(i).Name = sourceWS Then 
     bWsExists = True: Exit For 
    End If 
    Next i 

    If bWsExists Then 
     Sheets(sourceWS).Select 
    Else 
     Beep 
     MsgBox "Verknuepfungen_detail nicht gefunden!" 
    End If 

    ' Groesse bestimmen 
    rowCount = Range("A1").End(xlDown).Row 
    ' Debug.Print (j) 

    ' Schleife zum schreiben der aktualisierten Links 
    For j = 2 To rowCount 
     targetWS = Cells(j, 1) 
     targetCell = Cells(j, 2) 
     newFormula = Cells(j, 3) 

     Debug.Print (targetWS) 
     Debug.Print (targetCell) 
     Debug.Print (newFormula) 

     ' Pseudocode 
     ' Sheets(targetWS)!.Cell(targetCell).formula = newFormula 

     Sheets("targetWS").Range("targetCell").formula = newFormula 

    Next j 

End Sub 

Дело в том, что просто не будет работать, и я попытался его с «», и т.д., но не кажется, что это просто не будет делать это.

Вторая проблема, с которой я столкнулся, заключается в том, как автоматизировать эту вещь, чтобы я не обновлял только один файл Excel, а сотни его.

Вся помощь будет оценена по достоинству.

Answer 1

Sheets(targetWS).Range(targetCell).formula = newFormula

попробовать это.