bin mir jetzt nicht sicher, ob ich gegen eine Regel verstoße (habe zumindest diesbezüglich nichts einschränkendes gefunden), aber da ich auf meine Frage von gestern 11:21 Uhr leider keine Rückmeldung erhalten habe, poste ich meine Frage, diesmal etwas anders formuliert, nocheinmal.
Ich möchte von einem Tabellenblatt zu einem anderen derselben Datei bestimmte Werte übertragen.
"Zuordnungstabelle" beinhaltet einen Ausschnitt der "Adresseneingabe", auf "Zuordnungstabelle" wird von einer anderen Datei per SVERWEIS zugriffen, so dass die Spaltenanordnung so bleiben muss.
In "Adresseingabe" könnte es sein, dass neue Felder eingefügt werden müssen.
Es werden nur Werte mit einem Eintrag "a" in Spalte A übertragen.
Problem: Die Werteübertragung erfolgt mittels nachstehendem Code, der einen Bereich auswählt, kopiert und wieder einfügt. Wenn die Spalten in "Adresseingabe" sich ändern, werden die Werte u.U. den falschen Spalten in "Zuordnungstabelle" zugeordnet.
Sub Tabelle_füllen()
ActiveSheet.Unprotect
Range("B6:G100").ClearContents
Sheets("Adresseneingabe").Activate
Dim objRang As Range
Set objRang = ActiveSheet.Range(Cells(2, 1), _
Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
Application.ScreenUpdating = False
With ActiveSheet
For Each c In objRang
If c = "a" Then
.Range(Cells(c.Row, 2), Cells(c.Row, 7)).Copy _
Destination:=Worksheets("Zuordnungstabelle").Cells(Sheets(" _
Zuordnungstabelle"). _
Cells(Rows.Count, 5).End(xlUp).Row + 1, 2)
End If
Next
End With
Sheets("Zuordnungstabelle").Activate
Application.ScreenUpdating = True
End Sub
Um Fehler durch neue Spalten zu umgehen, stelle ich mir vor, die Übertragung abhängig von der Spaltenüberschrift zu machen. Diesbezüglich hatte ich im Netz einen Code gefunden, der die Werte abhängig von der Spaltenüberschrift zuordnet. Ich hatte es versucht, die beiden Codes miteinander zu verquicken, bin aber kläglich gescheitert, zumal ich nicht den ganzen Code aus dem Netz verstehe (siehe Beispieldatei).Anbei eine Beispieldatei: https://www.herber.de/bbs/user/72339.xls
Kann mir heute jemand helfen?
Gruß
Tobias