VBA Ausgewählte Zeilen kopieren und in anderer Tabelle einfügen (mit Variablen)?
Hallo Zusammen,
Ich hab ein Problem. Ich würde gern durch das schreiben einer 1 hinter meiner Materialsammlung per Knopfdruck alle gewählten Zeilen in eine Zusammengestellte Tabelle einfügen.
Die Materialsammlung bei der ich auswähle ist in Tabelle zwei und wird dann per Knopfdruck abgefragt. Die markierten sollen dann in Tabelle 1 in eine Tabelle eingefügt werden.
Da ich aber mit Variablen Arbeite ist das schwieriger als gedacht
Hier mein code zum verdeutlichen
Private Sub CommandButton1_Click()
Dim strBereich As Range Dim x As Integer
For x = 3 To 60 If Worksheets(2).Cells(x, 10) = "1" Then
Worksheets(1).Range(Cells(x, 2), Cells(x, 9))=Worksheets(2).Range(Cells(x, 1), Cells(x, 8))
End If Next x
End Sub
funktioniert leider aber nicht.
Bitte im Hilfe
2 Antworten
Stören dich die Lücken in der neuen Tabelle?
Dann brauchst du zwei Zeilen-Variablen, eine für die Quelltabelle und eine für die Zieltabelle.
Die Variable für die Quelltabelle kannst du nach wie vor in einer Zählschleife laufen lassen, die Variable für die Zieltabelle erhöhst du nur, wenn etwas einzutragen ist.
(Wenn du das Makro öfters aufrufen willst, vergiss nicht, die folgenden, nicht benötigten Zeilen der Zieltabelle zu leeren.)
Das sollte übrigens auch ohne Makro gehen.
Es könnte sein, dass
Worksheets(1).Range(Cells(x, 2), Cells(x, 9)).Value = Worksheets(2).Range(Cells(x, 1), Cells(x, 8)).Value
funktioniert, es würde mich aber überraschen, da Value die Standard-Eigenschaft eines Range-Objektes ist. ("Standardeigenschaft" bzw. "Default-Eigenschaft" bedeutet, dass man diese Eigenschaft nicht ausdrücklich nennen muss.)
Vermutlich kann man die Value-Eigenschaft eines Range-Objektes aus mehreren Zellen nicht so einfach setzen, selbst wenn die Größen (Breite und Höhe) der Bereiche übereinstimmen.
Dann musst du eine Schleife nehmen, die die Zellen einer Zeile einzeln kopiert. Oder du verwendest die eingebaute Copy-&-Paste-Funktion; das ist aber für so wenige Zellen aufwendiger und langsamer.
Auf die Idee alles einzeln zu machen bin ich noch gar nicht gekommen.
Habs jetzt so gemacht und es klappt.
Aber die lücken sind noch da
Dim x As Integer
For x = 3 To 60
If Worksheets(2).Cells(x, 10) = "1" Then
Worksheets(1).Cells(x, 2) = Worksheets(2).Cells(x, 2)
Worksheets(1).Cells(x, 3) = Worksheets(2).Cells(x, 3)
Worksheets(1).Cells(x, 4) = Worksheets(2).Cells(x, 4)
Worksheets(1).Cells(x, 5) = Worksheets(2).Cells(x, 5)
Worksheets(1).Cells(x, 6) = Worksheets(2).Cells(x, 6)
Worksheets(1).Cells(x, 7) = Worksheets(2).Cells(x, 7)
Worksheets(1).Cells(x, 8) = Worksheets(2).Cells(x, 8)
End If
Next x
Da muss ich dann eine neue variable für Tabelle1 nehmen. Aber ich weiß nicht wie ich das angebe das die variable sich immer nur erhöht um 1, wenn die Eine Zeile voll ist
x2 = 3 'oder entsprechender anderer Startwert in Zieltabelle
For x = 3 To 60
If Worksheets(2).Cells(x, 10) = "1" Then
'die folgenden Zeilen könnten auch mit einer eigenen Schleife ersetzt werden
Worksheets(1).Cells(x, 2) = Worksheets(2).Cells(x2, 2)
Worksheets(1).Cells(x, 3) = Worksheets(2).Cells(x2, 3)
Worksheets(1).Cells(x, 4) = Worksheets(2).Cells(x2, 4)
Worksheets(1).Cells(x, 5) = Worksheets(2).Cells(x2, 5)
Worksheets(1).Cells(x, 6) = Worksheets(2).Cells(x2, 6)
Worksheets(1).Cells(x, 7) = Worksheets(2).Cells(x2, 7)
Worksheets(1).Cells(x, 8) = Worksheets(2).Cells(x2, 8)
x2 = x2 + 1
End If
Next x
es gibt in VBA das Objekt .entirerow / .entirecolumn
Also zB
if CountA(activecell.entirerow.cells) > 0 (oder so ähnlich)
then activecell.entirerow.copy (alles in einer Zeile, das geht, weil kein Else notwendig, deshalb auch keine extra Zeile, auch kein End If)
Worksheets("soundso").Range("A1").end(xldown).offset(1, 0).entirerow.insert
sollte die koppierte Zeile an die bisherigen Einträge als neue Zeile anhängen (Sofern alle Zellen in Spalte A gefüllt)
probiers damit, hab das alles nur aus der Erinnerung raus gemacht, die Syntax stimmt nur ungefähr!
Probier mal Copy & Paste:
Call Worksheets(2).Range(Cells(x, 1), Cells(x, 8)).Copy( _
Worksheets(1).Range(Cells(x, 2), Cells(x, 9)))
Das kopieren klappt jetzt. bloß sind die Lücken zwischen den eingefügten Zeilen immer noch da. Diese möchte ich aber weghaben.
Da weiß ich im Moment nicht weiter.
Analog dem Beispiel von pwolff: weitere Variable, z.B. y
Call Worksheets(2).Range(Cells(x, 1), Cells(x, 8)).Copy( _
Worksheets(1).Range(Cells(y, 2), Cells(y, 9)))
direkt zu Beginn des Makros y=1 setzen als Anfangswert (gibt sonst eine Fehlermeldung)
und innerhalb der IF Abfrage y=y+1
Ja die Lücken stören aber dank dir weiß ich jetzt wie ich das weg bekomme. Danke schon mal.
Das Problem ist bloß das mein Code nicht funktioniert.
Ich eiß nicht wie ich die Zellbereiche kopiere. Da kommt immer entweder Syntaxfehler oder Objekt-Fehler