Guten Morgen,
erstmal vielen für eure Hilfe :)
Habe es nochmal ausprobiert, funktioniert aber leider bei mir nicht :(
Vllt. findet ihr ja den Fehler
Hier ist mehr von dem Code, er soll die weiteren Tabellen füllen, die Anzahl der Tabellen ist variabel. Bei mir funktioniert das nur mit dem umständlichen Code.. :/
FinalRow = Cells(Rows.Count, 25).End(xlUp).Row
FinalRow2 = Cells(Rows.Count, 1).End(xlUp).Row
For v = 1 To FinalRow
YearValue = Cells(v, 25).Value
For x = 5 To FinalRow2
ThisValue = Cells(x, 17).Value
f = 4 + v
If ThisValue = YearValue Then
ActiveSheet.Cells(x, 2).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row + 1), 2).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 5).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 7).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 16).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 62).Select
ActiveSheet.Paste
Sheets("tabelle").Select
' Sheets(f).Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row + 1), 2).Value = Sheets("Tabelle1").Cells(x, 2).Value
' Sheets(f).Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 7).Value = Sheets("Tabelle1").Cells(x, 5).Value
' Sheets(f).Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 62).Value = Sheets("Tabelle1").Cells(x, 16).Value
If Cells(x, 17) = Cells(x, 19) Then
ActiveSheet.Cells(x, 12).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 3).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 13).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 4).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 14).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 5).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 15).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 6).Select
ActiveSheet.Paste
Sheets("tabelle").Select
Else
ActiveSheet.Cells(x, 12).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 3).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 13).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 4).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 19).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 5).Select
ActiveSheet.Paste
If Selection = "" Then
Else
With Selection.Interior
.ColorIndex = 48
.Pattern = xlSolid
End With
End If
Sheets("tabelle").Select
ActiveSheet.Cells(x, 15).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 6).Select
ActiveSheet.Paste
'
Sheets("tabelle").Select
ActiveSheet.Cells(x, 14).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 63).Select
ActiveSheet.Paste
'
Sheets("tabelle").Select
End If
Else
ThisValue = Cells(x, 19).Value
If ThisValue = YearValue Then
ActiveSheet.Cells(x, 2).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row + 1), 2).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 9).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 7).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 16).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 62).Select
ActiveSheet.Paste
Sheets("tabelle").Select
If Cells(x, 17) = Cells(x, 19) Then
ActiveSheet.Cells(x, 12).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 3).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 13).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 4).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 14).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 5).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 15).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 6).Select
ActiveSheet.Paste
Sheets("tabelle").Select
Else
ActiveSheet.Cells(x, 17).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 3).Select
ActiveSheet.Paste
If Selection = "" Then
Else
With Selection.Interior
.ColorIndex = 48
.Pattern = xlSolid
End With
End If
'
Sheets("tabelle").Select
ActiveSheet.Cells(x, 12).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 63).Select
ActiveSheet.Paste
'
Sheets("tabelle").Select
ActiveSheet.Cells(x, 13).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 4).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 14).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 5).Select
ActiveSheet.Paste
Sheets("tabelle").Select
ActiveSheet.Cells(x, 15).Select
Selection.Copy
Sheets(f).Select
ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 6).Select
ActiveSheet.Paste
Sheets("tabelle").Select
End If
End If
End If
Next x
Next v
|