Kopieren und Einfügen Abhängig von Zellenwert

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Micha,
danke für deine Antwort, ich hoffe du hilfst mir noch etwas den Code weiter anzupassen.
Der Zelleninhalt A1 ist nich wirklich eine Zahl, sonder einer von zehn Buchstabenkürzel, z.B. ÜWH, ÜWB..., die Zahlen habe ich nur der Einfachkeit halber im Beispiel genannt.
Das Kürzel wird aus einer Liste heraus in der Zell A1 angewählt, also können wohl die Zeilen:
If Not IsNumeric(x) Then Exit Sub
If x 10 Then Exit Sub
entfallen. Die Zellenbereiche habe ich auch angepasst.
Dann sieht der Code so aus:

Sub Speichern()
' Speichern Makro
' Makro vom 14.03.2010
Dim x As Long
x = Range("A1")
Range("D12:D107").Copy Range("E12:E107").Offset(0, x)
End Sub

Nun ist mir aber noch nicht klar, wie das klappen kann, bzw. was noch hinzu kommen muss damit, wenn in A1 also z.B. ÜWH steht beim ausführen der Prozedur, der Zellenbereich (- jetzt B12:B107) in E12:E107 kopiert wird.
Anschließend will ich ja in A1 z.B. ÜWB anwählen, die Werte des Zellenbereichs B12:B107 ändern und den Inhalt in Spalte F12:F107 speicher, wobei kopieren hierfür das bessere Wort ist, denn gespeicher wird am Ende die komplette Mappe über das Menü.
Die Kopierfunktion soll also wie Beschrieben für zehn Fälle funktionieren und über einen Button den Zelleninhalt B12:B107 in die jeweilige Spalte Transportieren.
Vieleicht kannst du den Code noch etwas präzisieren, was bedeutet der Befehl Offset(0,x)?
Gruß Mirko

Sub Speichern() Dim wert As Variant Dim alle_werte As Variant Dim pos_des_wertes As Double alle_werte = Array("AAA", "BBB", "CCC", "DDD") 'musst Du mit Deinen Abkürzungen anpassen wert = Range("A1") pos_des_wertes = WorksheetFunction.Match(wert, alle_werte) Range("D12:D107").Copy Range("E12:E107").Offset(0, pos_des_wertes) End Sub

Sub Speichern() Dim wert As Variant Dim alle_werte As Variant Dim pos_des_wertes As Double alle_werte = Array("ÜWH", "ÜWB", "ÜSH", "ÜSB", "SWX", "SSX", "WWH", "WWB", "WSH", "WSB") 'musst _ Du mit Deinen Abkürzungen anpassen wert = Range("C1") pos_des_wertes = WorksheetFunction.Match(wert, alle_werte) Range("D12:D107").Copy Range("E12:E107").Offset(0, pos_des_wertes) Range("D12:D107").Copy Range("F12:F107").Offset(0, pos_des_wertes) Range("D12:D107").Copy Range("G12:G107").Offset(0, pos_des_wertes) Range("D12:D107").Copy Range("H12:H107").Offset(0, pos_des_wertes) Range("D12:D107").Copy Range("I12:I107").Offset(0, pos_des_wertes) Range("D12:D107").Copy Range("J12:J107").Offset(0, pos_des_wertes) Range("D12:D107").Copy Range("K12:K107").Offset(0, pos_des_wertes) Range("D12:D107").Copy Range("L12:L107").Offset(0, pos_des_wertes) Range("D12:D107").Copy Range("M12:M107").Offset(0, pos_des_wertes) Range("D12:D107").Copy Range("N12:N107").Offset(0, pos_des_wertes) End Sub

Hallo Micha,
bin noch mit anderen Dingen heute beschäftigt gewesen, und da der Code nicht auf anhieb wirkte, musste ich das bis eben etwas zurückstellen.
Habe nun damit ein bisschen rum probiert, mit lesen ist klar ... also wenn keine Ahnung vorhanden ist, dann geht da nichts. Konnte mir aber manches herleiten die definition und so, aber um das umzubauen fehlt mir einfach das Wissen und das kann ich mir auch nicht kurzfristig generieren.
Habe den Code nun so eingebaut:

Sub Speichern()
Dim wert As Variant
Dim alle_werte As Variant
Dim pos_des_wertes As Double
alle_werte = Array("ÜWH", "ÜWB", "ÜSH", "ÜSB", "SWX", "SSX", "WWH", "WWB", "WSH", "WSB") 'musst  _
_
Du mit Deinen Abkürzungen anpassen
wert = Range("A1")
pos_des_wertes = WorksheetFunction.Match(wert, alle_werte)
Range("D12:D107").Copy Range("E12:E107").Offset(0, pos_des_wertes)
End Sub

...leider passiert nichts, rein garnix, nicht mal ein Bug kommt.
Werden aber auch keine Zellen irgendwo hin kopiert damit ich dann die Positionen anpassen könnte.
Habe also etwas mit der Null von Offset gespielt hatte aber auch keine Wirkung, nichts passiert. Die Zeilen einzubauen, die du mir im ersten Code mitgeliefert hast und später nochmal auf deren Notwndigkeit verwiesen hast, habe ich bisher nicht wieder eingesetzt.
If Not IsNumeric(x) Then Exit Sub
If x 10 Then Exit Sub
Da die sich ja auf Zahlenwerte Numeric in der veränderbaren Zelle beziehen, nun aber es doch Buchstabenkürzel sind, müssen die also noch umgeschrieben werden denke ich, wahrscheinlich anstatt Numeric etwa auch Variant, würde dann so aussehen:
If not IsVariant Then Exit Sub
If Not Isalle_Werte Then Exit Sub
Wir hoffentlich noch was mit dem Code, würde gerne einen Schritt weiter kommen mit dem Problem.
Gruss-mirko

Beliebteste Forumthreads (12 Monate)

Kopieren und Einfügen Abhängig von Zellenwert

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

363 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kopieren und Einfügen Abhängig von Zellenwert

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

363 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread