Sub Kopieren()
Const Kritspalte = 5
Const Quellspalte = 36
Const zielspalte = 1
Dim Quelle As Object, Ziel As Object, zeile As Long, zielzeile As Long
Set Quelle = ActiveSheet
Set Ziel = Worksheets.Add(after:=Worksheets(Sheets.Count))
zielzeile = 1
With Quelle
For zeile = 4 To .Cells(.Rows.Count, Quellspalte).End(xlUp).Row
If Not IsEmpty(.Cells(zeile, Kritspalte)) Then
Ziel.Cells(zielzeile, zielspalte).NumberFormat = "@"
Ziel.Cells(zielzeile, zielspalte) = .Cells(zeile, Quellspalte).Text
zielzeile = zielzeile + 1
End If
Next zeile
End With
End Sub
Sub um den unteren Rest.
Gruß der ALteDresdner
Next zeile
End With
'Kopieren der ausgesuchten Werte
Ziel.Range("A1:A" & Ziel.Cells(Ziel.Rows.Count, 1).End(xlUp).Row).Copy
'Löschen des temporär erzeugten Blattes, erst nach erfolgreichem Einfügen!!!!
Application.DisplayAlerts = False
Ziel.Delete
Application.DisplayAlerts = True
End Sub
#"Entfernte Spalten" = Table.RemoveColumns(#"Gefilterte Zeilen",{"xxx", "xxx2", "xxx3", "xxx4", "xxx5", "xxx6", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "A", "B", "c", "xx", "Kriterium"})
genügt diese Zeile: = #"Andere entfernte Spalten" = Table.SelectColumns(#"Gefilterte Zeilen",{"Daten kopieren"})Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen