Tabelle in neues Blatt kopieren (again)

Hallo VBA Experten,
das Thema ist oft behandelt worden aber ich habe leider nicht genug know how, die verschiedenen Beispiele so zusammenzusetzen, dass es für mich funktioniert.
Aus einer Tabelle (aktive Tabelle) möchte ich alle Zeilen, die einen bestimmten Wert in einer Spalte enthalten (der Wert ist Teil eines längeren String) in eine neue Mappe kopiert werden.
In der Filter-Spalte stehen Werte wie z.B.
top2020,top2021
top2019
top2019,top2020
Ideale Lösung ist, dass für alle gefundenen Jahreszahlen die jeweiligen Zeilen in eine neue Arbeitsmappe kopiert werden und die Mappe einen entsprechenden Namen bekommen (xxx_2020.xlsx)
Sollte das schwer umzusetzen sein, wäre auch möglich, jeweils die Jahreszahl über ein Input abzufragen und dann die Zeilen in ein neues Blatt kopieren.
Zusätzlich sollen nicht alle, sondern nur bestimmte Spalten kopiert werden und lediglich Werte und Formate, keine Formeln kopiert werden.
Könnt ihr mich dabei unterstützen?
Vielen Dank und viele Grüße
Mat

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
beispielsweise so.
weils einfacher ist, kopiere ich zuerst alles und lösche dann raus, was nicht benötigt wird


Sub xxx()
Dim Jahr As Long
Dim wb As Workbook
Dim shQ As Worksheet
Dim shZ As Worksheet
Set shQ = ActiveSheet
Set wb = Workbooks.Add(xlWBATWorksheet)
Set shZ = wb.Sheets(1)
For Jahr = 2015 To 2025 'alle jahre, die theoretisch in Frage kommen
If WorksheetFunction.CountIf(sh.Columns(1), "*" & Jahr & "*") > 0 Then
'--- alles als Wert mit Format übertragen
shQ.UsedRange.Copy
shZ.Cells(1, 1).PasteSpecial xlPasteValues
shZ.Cells(1, 1).Pastespeical xlPasteFormats
shZ.Cells(1, 1).PasteSpecial xlPasteColumnWidths
'--- nicht benötigte Zeilen löschen
With shZ.UsedRange
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = "=IF(Countif(RC1,""*""&Jahr&""*""),Row(),0)"
.Cells(1, 1).Value = 0
.EntireRow.RemoveDuplicates .Column, xlNo
.ClearContents
End With
End With
'--- nicht benötigte Spalten löschen
shZ.Range("B1,D1,F1:I1,Z1").EntireColumn.Delete
'--- speichern
wb.SaveAs ThisWorkbook.Path & "\xxx_" & Jahr, FileFormat:=xlOpenXMLWorkbook
End If
Next
wb.Close False
End Sub

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Tabelle in neues Blatt kopieren (again)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabelle in neues Blatt kopieren (again)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread