Ausgewählte Zellen copy + untereinander einfügen
06.05.2019 18:31:56
Stallkamp
ich habe folgendes Problem: Ich habe zwei ausgewählte Spalten aus jeweils zwei verschiedenen Arbeitsblättern ->Tabelle1 & Tabelle2. Diese Spalten werden gefiltert, ausgewählt und anschließend sollen sie in ein neues Arbeitsblatt Tabelle3 kopiert werden.
Nun sollen diese kopierten Zellen untereinander eingefügt werden. Ich habe es mit folgendem Code probiert, jedoch werden nur die ausgewählten Zellen des Arbeitsblattes "Tabelle1" eingefügt.
Wie kann ich diese untereinander einfügen?
Danke im Voraus.
Private Sub Commandbutton1_Click()
Application.ScreenUpdating = False
Sheets("Tabelle2").Select
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 14
ActiveSheet.Columns("O:P").Select
Selection.SpecialCells(xlCellTypeFormulas, 22).Select
' Filtern
ActiveSheet.Range("$A$3:$AE$800").AutoFilter Field:=16
ActiveSheet.Range("$A$3:$AE$800").AutoFilter Field:=16, Criteria1:="kein Wert", _
Operator:=xlAnd
' Filtern zu Ende
Sheets("Tabelle1").Select
ActiveSheet.Columns("F:G").Select
ActiveSheet.Range("G1").Activate
Selection.SpecialCells(xlCellTypeFormulas, 22).Select
ActiveSheet.Range("$F$2:$G$800").AutoFilter Field:=2
ActiveSheet.Range("$G$3:$G$800").AutoFilter Field:=2, Criteria1:="kein Wert", _
Operator:=xlAnd
Selection.Copy
Sheets("Tabelle3").Select
Range("A9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Anzeige