Danke, Sven
Das ist mein derzeitiger Code:
Sub superCopy()
Dim msg
Dim wksPers As Worksheet
Dim wksZiel As Worksheet
Dim intAnz As Integer
Dim lngZiel As Long
Dim varFind As Variant
lngZiel = 2
Set wksPers = Worksheets(1)
intAnz = Worksheets.Count
If intAnz < 2 Then Exit Sub
Worksheets.Add.Move After:=Worksheets(Worksheets.Count)
Set wksZiel = Worksheets(Worksheets.Count)
For intWks = 2 To intAnz
varKrit = Worksheets(intWks).Name
If varKrit = "" Then
GoTo Weiter
Else
With wksPers.Range("B:B")
Set varFind = .Find(What:=varKrit, After:=Range("B2"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious, _
MatchCase:=True)
If Not varFind Is Nothing Then
Rows(1).Font.FontStyle = "Fett"
wksZiel.Name = "Auswertung"
wksZiel.Range("a1") = "Pers-Nr."
wksZiel.Range("b1") = "Name, Vorname"
wksZiel.Range("c1") = "Abteilung"
wksZiel.Range("d1") = "Jahr"
wksZiel.Range("e1") = "K /Tage"
wksZiel.Range("f1") = "Ko /Tage"
wksZiel.Range("g1") = "Urlaub"
wksZiel.Range("h1") = "Üb dieses Jahr"
wksZiel.Range("i1") = "Ab dieses Jahr"
wksZiel.Range("j1") = "Üb-Ab gesamte Jahre"
If Year(Date) = 2006 Then
Worksheets(intWks).Range("b2").Copy 'Pers-Nr
wksZiel.Cells(lngZiel, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("H2").Copy 'Name
wksZiel.Cells(lngZiel, 2).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("S2").Copy 'Abteilung
wksZiel.Cells(lngZiel, 3).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("B62").Copy 'Jahr
wksZiel.Cells(lngZiel, 4).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("at112").Copy 'krank/Tage
wksZiel.Cells(lngZiel, 5).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("au112").Copy 'krank ohne/Tage
wksZiel.Cells(lngZiel, 6).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("ba113").Copy 'Urlaub
wksZiel.Cells(lngZiel, 7).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("av112").Copy 'Überstunden
wksZiel.Cells(lngZiel, 8).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("aw112").Copy 'Abbau Überstunden
wksZiel.Cells(lngZiel, 9).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("bg112").Copy 'Differenz Üb-Ab
wksZiel.Cells(lngZiel, 10).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
lngZiel = lngZiel + 1
End If
If Year(Date) = 2007 Then
Worksheets(intWks).Range("b2").Copy 'Pers-Nr
wksZiel.Cells(lngZiel, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("H2").Copy 'Name
wksZiel.Cells(lngZiel, 2).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("S2").Copy 'Abteilung
wksZiel.Cells(lngZiel, 3).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("B62").Copy 'Jahr
wksZiel.Cells(lngZiel, 4).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("at168").Copy 'krank/Tage
wksZiel.Cells(lngZiel, 5).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("au168").Copy 'krank ohne/Tage
wksZiel.Cells(lngZiel, 6).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("ba169").Copy 'Urlaub
wksZiel.Cells(lngZiel, 7).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("av168").Copy 'Überstunden
wksZiel.Cells(lngZiel, 8).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("aw168").Copy 'Abbau Überstunden
wksZiel.Cells(lngZiel, 9).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets(intWks).Range("bg168").Copy 'Differenz Üb-Ab
wksZiel.Cells(lngZiel, 10).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
lngZiel = lngZiel + 1
End If
Else
GoTo Weiter
End If
End With
End If
Weiter:
Next
End Sub