Hallo Matze,
das ist aber ein langer Code:
Sub SpkEinlesenDateiAnlegen()
'Application.EnableEvents = False
'Applicaton.ScreenUpdating = True
'Application.ScreenUpdating = False
'Übertrag der Datenüberschrift für Liquiditätslage
Sheets("Grundsatz").Select
Rows("1:3").Select
Selection.Copy
Sheets("Seite 15b").Select
Range("A34").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Grundsatz").Select
Application.CutCopyMode = False
'Übertrag der Datenüberschrift für Verbindlichkeiten
Sheets("PSt_Einlagen").Select
Rows("1:3").Select
Selection.Copy
Sheets("Seite 29").Select
Range("A50").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Seite 31").Select
Range("A51").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("PSt_Einlagen").Select
Application.CutCopyMode = False
'Übertrag der Datenüberschrift für Kredite
Sheets("PSt_Branchen").Select
Rows("1:2").Select
Selection.Copy
Sheets("Seite 38").Select
Range("A31").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("PSt_Branchen").Select
Application.CutCopyMode = False
Rows("5:8").Select
Selection.Copy
Sheets("Seite 38").Select
Range("A35").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("PSt_Branchen").Select
Application.CutCopyMode = False
'Übertrag der Datenüberschrift für Gewi Durchschnitt
Sheets("Überblick").Select
Rows("1:3").Select
Selection.Copy
Sheets("Durchschnitt").Select
Range("A32").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Dim Name As String
Dim Sparkasse(52) As String
Sparkasse(1) = "2103"
Sparkasse(2) = "2105"
Sparkasse(3) = "2106"
Sparkasse(4) = "2107"
Sparkasse(5) = "2108"
Sparkasse(6) = "2110"
Sparkasse(7) = "2111"
Sparkasse(8) = "2112"
Sparkasse(9) = "2113"
Sparkasse(10) = "2114"
Sparkasse(11) = "2115"
Sparkasse(12) = "2116"
Sparkasse(13) = "2118"
Sparkasse(14) = "2119"
Sparkasse(15) = "2121"
Sparkasse(16) = "2123"
Sparkasse(17) = "2125"
Sparkasse(18) = "2126"
Sparkasse(19) = "2127"
Sparkasse(20) = "2128"
Sparkasse(21) = "2129"
Sparkasse(22) = "2130"
Sparkasse(23) = "2201"
Sparkasse(24) = "2202"
Sparkasse(25) = "2203"
Sparkasse(26) = "2204"
Sparkasse(27) = "2205"
Sparkasse(28) = "2208"
Sparkasse(29) = "2210"
Sparkasse(30) = "2216"
Sparkasse(31) = "2218"
Sparkasse(32) = "2219"
Sparkasse(33) = "2221"
Sparkasse(34) = "2224"
Sparkasse(35) = "2313"
Sparkasse(36) = "2315"
Sparkasse(37) = "2316"
Sparkasse(38) = "2317"
Sparkasse(39) = "2318"
Sparkasse(40) = "2319"
Sparkasse(41) = "2325"
Sparkasse(42) = "2326"
Sparkasse(43) = "2329"
Sparkasse(44) = "2332"
Sparkasse(45) = "2335"
Sparkasse(46) = "2337"
Sparkasse(47) = "2340"
Sparkasse(48) = "2341"
Sparkasse(49) = "2343"
Sparkasse(50) = "2346"
Sparkasse(51) = "2002"
Sparkasse(52) = "2024"
For i = 3 To 4
Name = Sparkasse(i)
'Übertrag der Daten für Verbindlichkeiten (3 Jahre)
Sheets("PSt_Einlagen").Select
Columns("A:A").Select
Selection.Find(What:=Sparkasse(i), After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
ActiveCell.Rows("1:3").EntireRow.Select
Selection.Copy
Sheets("Seite 29").Select
Range("A53").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Seite 31").Select
Range("A54").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Übertrag der Daten für Liqiditätslage (13 Monate)
Sheets("Grundsatz").Select
Columns("A:A").Select
Selection.Find(What:=Sparkasse(i), After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
ActiveCell.Rows("1:13").EntireRow.Select
Selection.Copy
Sheets("Seite 15b").Select
Range("A38").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Übertrag der Daten für Kredite (2 Jahre)
Sheets("PSt_Branchen").Select
Columns("A:A").Select
Selection.Find(What:=Sparkasse(i), After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
ActiveCell.Rows("1:2").EntireRow.Select
Selection.Copy
Sheets("Seite 38").Select
Range("A33").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Übertrag der Daten für Gewi (13 Monate)
Sheets("Überblick").Select
Columns("A:A").Select
Selection.Find(What:=Sparkasse(i), After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
ActiveCell.Rows("1:13").EntireRow.Select
Selection.Copy
Sheets("Durchschnitt").Select
Range("A35").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Übertrag der BVNR und Institutsname in Tabellen
Sheets("Spk-Name").Select
Columns("A:A").Select
Selection.Find(What:=Sparkasse(i), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Zeile = ActiveCell.Row
Range("A" & Zeile, "B" & Zeile).Copy
Sheets("Seite 15b").Select
Range("A38").Select
ActiveSheet.Paste
Sheets("Seite 29").Select
Range("A53:B55").Select
ActiveSheet.Paste
Sheets("Seite 31").Select
Range("A54:B56").Select
ActiveSheet.Paste
Sheets("Seite 38").Select
Range("A33:B34").Select
ActiveSheet.Paste
Sheets("Durchschnitt").Select
Range("A35:B47").Select
ActiveSheet.Paste
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Spk-Name").Select
Application.CutCopyMode = False
'Datei der jeweiligen Sparkasse wird angelegt
Sheets(Array("Seite 15b", "Seite 29", "Seite 31", "Seite 38", "Durchschnitt")). _
Select
Sheets("Seite 15b").Activate
Sheets(Array("Seite 15b", "Seite 29", "Seite 31", "Seite 38", "Durchschnitt")).Copy
Sheets(Array("Seite 15b", "Seite 29", "Seite 31", "Seite 38", "Durchschnitt")). _
Select
Sheets("Seite 15b").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F20").Select
Application.CutCopyMode = False
Sheets("Durchschnitt").Select
Rows("30:54").Select
'Selection.ClearContents
Selection.Delete Shift:=xlUp
Range("A1:C1").Select
Sheets("Seite 38").Select
Rows("29:41").Select
'Selection.ClearContents
Selection.Delete Shift:=xlUp
Range("A1:G1").Select
Sheets("Seite 31").Select
Rows("42:81").Select
'Selection.ClearContents
Selection.Delete Shift:=xlUp
Range("A1:G1").Select
Sheets("Seite 29").Select
Rows("49:60").Select
'Selection.ClearContents
Selection.Delete Shift:=xlUp
Range("A1:F1").Select
Sheets("Seite 15b").Select
Rows("34:55").Select
'Selection.ClearContents
Selection.Delete Shift:=xlUp
Range("A1:F1").Select
'Dateiname wird vergeben
ActiveWorkbook.SaveAs Filename:= _
"H:\MIS\OEFFENT\PRUEFSTE\SPK-Dateien\ArbeitsbogenJAP-2011_0" + Name + ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Sheets("Info").Select
Range("A1").Select
Next i
'Applicaton.ScreenUpdating = True
End Sub