Daten in aktuelles Tabellenblatt kopieren basierend auf kritieren
17.06.2020 13:14:42
Ulf
ich habe eine eurer Lösungen zum Kopieren von Daten aus einem Tabellenblatt basierend auf einem Kriterium in einer anderen Zelle erflogreich angewandt:
https://www.herber.de/forum/archiv/1008to1012/1009092_Wenn_Wert_in_Zelle_groesser_0_dann_kopiere.html
Nun möchte ich das Makro aber dahingehenn ausbauen, dass als Quelldatei eine anderes Excelfile verwendet wird und die geöffnete Arbeitsmappe kopiert werden soll.
Ausserdem möchte ich vermeiden, dass beim erneuten Ausführen des Makros (ich verwende dieses, welches beim Klicken ausgeführt wird) alte Einträge überschrieben werden, sonder nur unten an die Liste angehängt wird.
Kann mir jemand damit helfen?
Hier nochmal der Code welchen ich aktuell verwende
Sub Schaltfläche1_Klicken()
Application.ScreenUpdating = False
Dim intWert As Integer, intSpalte As Integer, intZeile As Integer, intAnz As Integer
ActiveWorkbook.Worksheets("Tabelle2").Range("a1:A60000").ClearContents
intSpalte = 11 'auf Spalte K gesetzt
intZeile = 1
intAnz = WorksheetFunction.CountA(ActiveWorkbook.Worksheets("Tabelle1").Range("A2:A10000"))
Zae2 = 0
For Zae1 = 1 To intAnz
intWert = ActiveWorkbook.Worksheets("Tabelle1").Cells(intZeile + Zae1, intSpalte) 'Anzahl _
_
_
zeilen in Variable geschrieben
If intWert >= 4 Then 'wenn Wert in Spalte K größer-gleich 4
ActiveWorkbook.Worksheets("Tabelle1").Range(Cells(intZeile + Zae1, 1), Cells(intZeile + _
_
_
Zae1, 8)).Copy
ActiveWorkbook.Worksheets("Tabelle2").Cells(intZeile + Zae2, 1).PasteSpecial
Application.CutCopyMode = False
Zae2 = Zae2 + 1
End If
Next Zae1
Application.ScreenUpdating = True
End Sub
Anzeige