Hallo Jack! Ja,das klappt super! Ich hab den Code mal für alle Bedingungen erweitert:
Sub Makro1()
ausgang1 = Worksheets("Hintergrundtabelle").Cells(Rows.Count, 8).End(xlUp).Row + 1
With Worksheets("Datenzusammenführung").Range("a2:m" & Range("M2").End(xlDown).Row)
.AutoFilter Field:=4, Criteria1:="S2"
.AutoFilter Field:=7, Criteria1:="C1"
.AutoFilter Field:=12, Criteria1:=""
Worksheets("Datenzusammenführung").Range("m2:m" & Range("M2").End(xlDown).Row). _
SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Hintergrundtabelle").Range("H1")
Worksheets("Hintergrundtabelle").Range("H1:h" & Range("H1").End(xlDown).Row). _
RemoveDuplicates Columns:=1, Header:=xlNo
'Worksheets("Hintergrundtabelle").Range("H1:h" & Range("H1").End(xlDown).Row).Interior. _
_
ColorIndex = 3
Worksheets("Datenzusammenführung").UsedRange.AutoFilter
End With
With Worksheets("Datenzusammenführung").Range("a2:m" & Range("M2").End(xlDown).Row)
.AutoFilter Field:=4, Criteria1:="S2"
.AutoFilter Field:=7, Criteria1:="C2"
.AutoFilter Field:=12, Criteria1:=""
Worksheets("Datenzusammenführung").Range("m2:m" & Range("M2").End(xlDown).Row). _
SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Hintergrundtabelle").Cells(ausgang1, 8)
' Hier Bestimmst du die "Ausmaße"
ausgang2 = Worksheets("Hintergrundtabelle").Cells(Rows.Count, 8).End(xlUp).Row
With Worksheets("Hintergrundtabelle")
.Range(.Cells(ausgang1 - 1, 8), .Cells(ausgang2, 8)).RemoveDuplicates Columns:=1, _
Header:=xlNo
End With
Worksheets("Datenzusammenführung").UsedRange.AutoFilter
End With
With Worksheets("Datenzusammenführung").Range("a2:m" & Range("M2").End(xlDown).Row)
.AutoFilter Field:=4, Criteria1:="S2"
.AutoFilter Field:=7, Criteria1:="C3"
.AutoFilter Field:=12, Criteria1:=""
Worksheets("Datenzusammenführung").Range("m2:m" & Range("M2").End(xlDown).Row). _
SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Hintergrundtabelle").Cells(ausgang2, 8)
' Hier Bestimmst du die "Ausmaße"
ausgang3 = Worksheets("Hintergrundtabelle").Cells(Rows.Count, 8).End(xlUp).Row
With Worksheets("Hintergrundtabelle")
.Range(.Cells(ausgang2 - 1, 8), .Cells(ausgang3, 8)).RemoveDuplicates Columns:=1, _
Header:=xlNo
End With
Worksheets("Datenzusammenführung").UsedRange.AutoFilter
End With
With Worksheets("Datenzusammenführung").Range("a2:m" & Range("M2").End(xlDown).Row)
.AutoFilter Field:=4, Criteria1:="S2"
.AutoFilter Field:=7, Criteria1:="C4"
.AutoFilter Field:=12, Criteria1:=""
Worksheets("Datenzusammenführung").Range("m2:m" & Range("M2").End(xlDown).Row). _
SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Hintergrundtabelle").Cells(ausgang3, 8)
' Hier Bestimmst du die "Ausmaße"
ausgang4 = Worksheets("Hintergrundtabelle").Cells(Rows.Count, 8).End(xlUp).Row
With Worksheets("Hintergrundtabelle")
.Range(.Cells(ausgang3 - 1, 8), .Cells(ausgang4, 8)).RemoveDuplicates Columns:=1, _
Header:=xlNo
End With
Worksheets("Datenzusammenführung").UsedRange.AutoFilter
End With
With Worksheets("Datenzusammenführung").Range("a2:m" & Range("M2").End(xlDown).Row)
.AutoFilter Field:=4, Criteria1:="S2"
.AutoFilter Field:=7, Criteria1:="C5"
.AutoFilter Field:=12, Criteria1:=""
Worksheets("Datenzusammenführung").Range("m2:m" & Range("M2").End(xlDown).Row). _
SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Hintergrundtabelle").Cells(ausgang4, 8)
' Hier Bestimmst du die "Ausmaße"
ausgang5 = Worksheets("Hintergrundtabelle").Cells(Rows.Count, 8).End(xlUp).Row
With Worksheets("Hintergrundtabelle")
.Range(.Cells(ausgang4 - 1, 8), .Cells(ausgang5, 8)).RemoveDuplicates Columns:=1, _
Header:=xlNo
End With
Worksheets("Datenzusammenführung").UsedRange.AutoFilter
End With
With Worksheets("Datenzusammenführung").Range("a2:m" & Range("M2").End(xlDown).Row)
.AutoFilter Field:=4, Criteria1:="S2"
.AutoFilter Field:=7, Criteria1:="C6"
.AutoFilter Field:=12, Criteria1:=""
Worksheets("Datenzusammenführung").Range("m2:m" & Range("M2").End(xlDown).Row). _
SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Hintergrundtabelle").Cells(ausgang5, 8)
' Hier Bestimmst du die "Ausmaße"
ausgang6 = Worksheets("Hintergrundtabelle").Cells(Rows.Count, 8).End(xlUp).Row
With Worksheets("Hintergrundtabelle")
.Range(.Cells(ausgang5 - 1, 8), .Cells(ausgang6, 8)).RemoveDuplicates Columns:=1, _
Header:=xlNo
End With
Worksheets("Datenzusammenführung").UsedRange.AutoFilter
End With
With Worksheets("Datenzusammenführung").Range("a2:m" & Range("M2").End(xlDown).Row)
.AutoFilter Field:=4, Criteria1:="S2"
.AutoFilter Field:=7, Criteria1:="C7"
.AutoFilter Field:=12, Criteria1:=""
Worksheets("Datenzusammenführung").Range("m2:m" & Range("M2").End(xlDown).Row). _
SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Hintergrundtabelle").Cells(ausgang6, 8)
' Hier Bestimmst du die "Ausmaße"
ausgang7 = Worksheets("Hintergrundtabelle").Cells(Rows.Count, 8).End(xlUp).Row
With Worksheets("Hintergrundtabelle")
.Range(.Cells(ausgang6 - 1, 8), .Cells(ausgang7, 8)).RemoveDuplicates Columns:=1, _
Header:=xlNo
End With
Worksheets("Datenzusammenführung").UsedRange.AutoFilter
End With
With Worksheets("Datenzusammenführung").Range("a2:m" & Range("M2").End(xlDown).Row)
.AutoFilter Field:=4, Criteria1:="S2"
.AutoFilter Field:=7, Criteria1:="C8"
.AutoFilter Field:=12, Criteria1:=""
Worksheets("Datenzusammenführung").Range("m2:m" & Range("M2").End(xlDown).Row). _
SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Hintergrundtabelle").Cells(ausgang7, 8)
' Hier Bestimmst du die "Ausmaße"
ausgang8 = Worksheets("Hintergrundtabelle").Cells(Rows.Count, 8).End(xlUp).Row
With Worksheets("Hintergrundtabelle")
.Range(.Cells(ausgang7 - 1, 8), .Cells(ausgang8, 8)).RemoveDuplicates Columns:=1, _
Header:=xlNo
End With
Worksheets("Datenzusammenführung").UsedRange.AutoFilter
End With
End Sub
Es sind zwar ein paar Leerzellen dazwischen, aber das sollte nicht das Problem sein.
Vielen, vielen Dank!!