Adressänderung über mehrere Blätter
15.03.2006 19:06:43
Jürg
habe heute Mittag folgendes Problem ins Forum gestellt:
Hallo liebe Excel-Spezis
wieder einmal habe ich ein Problem wo ich leider nicht weiter weiss, wie ich es am Besten lösen könnte:
Im Forum und auf CD habe ich leider nichts passendes gefunden, folgendes Problem!
Ich habe eine Mappe mit verschiednen Tabellen im Beispiel Ort1, Ort2 und Ort3 natürlich mit viel mehr Tabellenblättern bis Ort 200, aber im Beispiel genügen wohl 3 Tabellenblätter.
Nun bekomme ich die Personalnummer eines Mitarbeiters, welche die Adresse geändert hat aus einem Ort1 Beispiel, ich ändere diese Adresse in der Tabelle Ort1, da aber dieser Mitarbeiter auch in einem anderen Ort arbeitet, sollte es möglich sein, dass über die Personalnummer auf Ort2 und Ort3 etc.. meine Änderung aus Ort1 übernommen wird.
Dabei ist zu erwähnen, dass der jeweilige Mitarbeiter auf den Tabellenblättern (Ort1, 0rt2, Ort3 etc...) auf anderen Zellpositionen stehn kann! Als Beispiel:
Personalnummer 1234567 Ort1 F2
Personalnummer 1234567 Ort2 F7
Personalnummer 1234567 Ort3 F3
Diese Änderung von Personalnummer 1234567 Ort1 möchte ich auf allen Blättern mit der entsprechenden Personalnummer automatisch übernehmen.
Geht sowas und wenn ja wie muss ich das anstellen?
UweD
hat mir eine tolle Lösung geliefert, leider sind meine VBA-Kenntnisse nicht gut.
Wie stelle ich es an, oder welchen Code benötige ich, wenn ich Name, Strasse und PLZ auch ändern muss?
Der Code von UweD ändert nur den Wohort, ich muss aber auch Name, Strasse und PLZ ändern können.
Nachfolgend Code von UweD:
Sub tausch_ort()
Dim Z, Was$, NeuOrt$, c, firstAddress
Was = InputBox("Personalnummer", "Frage1")
If Was = "" Then Exit Sub
NeuOrt = InputBox("Neuer Wohnort", "Frage2")
If NeuOrt = "" Then Exit Sub
For Z = 1 To Sheets.Count
With Sheets(Z).Cells
Set c = .Find(Was, LookIn:=xlFormulas)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Offset(0, -1).Value = NeuOrt
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next Z
End Sub
Möchte mich im Voraus jetzt schon bedanken für eure Hilfe
Lieber Gruss
Jürg
https://www.herber.de/bbs/user/31925.xls