AW: Daten aus anderer Datei holen
20.09.2024 11:23:29
UweD
Hallo
Über VBA könnte der Pfad zur Datei geändert werden.
Ich habe mal was geschrieben, aber selbst mir, wo ich das Vorgehen kenne sind Fehler passiert und der Ablauf wurde gestört
- Der Pfad steht in A1 auf dem ersten Blatt
- Wird dort was geändert, wird erst ermittelt, was vorher dort stand
- das Makro durchläuft nun alle Zellen, die eine Formel enthalten und tauscht den Vorherpfad durch den neu eingegebene Pfad aus
- das gleiche macht er für alle Tabellenblätter
Das Ganze läuft automatisch ab, bei Änderungen in A1
Fehleranfällig:
- beim ersten Durchlauf, wenn der Pfad in den Formeln nicht zu dem Wert in A1 passt / Das solltest du sicherstellen, bevor du den Code wie folgt reinkopierst
- Auch sollten Die Quelldateien geschlossen sein
Gehe wie folgt vor
- Rechtsclick auf den Tabellenblattreiter (Tabelle1)
- Code anzeigen
- Das hier reinkopieren
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TB As Worksheet, Z, AltFormel As String, NeuFormel As String
On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
If Not Intersect(Target, Range("A1")) Is Nothing Then
'Alte Formel ermitteln
NeuFormel = UCase(ActiveSheet.Range("A1"))
With Application
.EnableEvents = False
.Undo
AltFormel = UCase(ActiveSheet.Range("A1")) 'alte Formel vor der Änderung
ActiveSheet.Range("A1") = NeuFormel 'Neue Formel wieder reinsetzen
.EnableEvents = True
End With
'Jedes Blatt wird durchlaufen
For Each TB In ThisWorkbook.Worksheets
Application.EnableEvents = False
For Each Z In TB.Cells.SpecialCells(xlCellTypeFormulas, 23) ' alle Zellen mit Formel
'in der Formel wird der Pfad ersetzt
Z.Formula = UCase(Replace(UCase(Z.Formula), AltFormel, NeuFormel))
Next
Application.EnableEvents = True
Next
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub
LG UweD