Hallo Zusammen,
beim Ausführen meines Excel-Makros führt dies fast immer zum Abbruch von Excel. Es erscheint die Fehlermeldung, dass nicht genügend Arbeitsspreicher vorhanden ist. Habe im Tastmanager den Verlauf der Auslastung angeschaut und das Makro nimmt in Spitzen bis zu 1 GB Arbeitsspeicher ein. Könnt ihr mir da bitte weiterhelfen und evtl das Problem gemeinsam lösen. Ich weiß auch, dass ich noch einige Stellen im Code überarbeiten muss, vor allem die Zeilen mit select und co.
Code:
Sub Baustellenkontrollen()
Dim WBZiel As Workbook, ExportDatei As Variant
Dim WBQuelle As Workbook, WSZiel As Worksheet
Dim wks As Worksheet
Set WBZiel = ThisWorkbook
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Sheets("V03").Select
Set wks = ActiveSheet
With wks
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
Else
.UsedRange.AutoFilter
End If
End With
Cells.Select
Selection.ClearContents
Sheets("V03 erweitert").Select
Set wks = ActiveSheet
With wks
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
Else
.UsedRange.AutoFilter
End If
End With
Cells.Select
Selection.ClearContents
Set wks = ActiveSheet
With wks
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
Else
.UsedRange.AutoFilter
End If
End With
Cells.Select
Selection.ClearContents
'Datei öffnen, Dialog anbieten
ExportDatei = Application.GetOpenFilename("Excel-Dateien, *.xlsx*", , "Bitte die Datei zum Kopieren öffnen ...")
ExportDatei = CStr(ExportDatei)
If ExportDatei = "Falsch" Then Exit Sub
'öffnen der ausgewählten Datei
Set WBQuelle = Workbooks.Open(ExportDatei)
'kopieren des Blattinhaltes und Schließen der Quell-Datei
With WBQuelle
.Sheets("V03").Range("A1:KT9000").Copy WBZiel.Sheets("V03").Range("A1")
.Close savechanges:=False
End With
Set WBQuelle = Workbooks.Open(ExportDatei)
With WBQuelle
.Sheets("V03 erweitert").Range("A1:KT9000").Copy WBZiel.Sheets("V03 erweitert").Range("A1")
.Close savechanges:=False
Set WBQuelle = Workbooks.Open(ExportDatei)
End With
With WBQuelle
.Sheets("V0405").Range("A1:KT9000").Copy WBZiel.Sheets("V0405").Range("A1")
.Close savechanges:=False
End With
WBZiel.Sheets("V03").Activate
Dim loLetzte As Long
With Worksheets("V03") 'Blattname
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Columns("L:L").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L1").Select
ActiveCell.FormulaR1C1 = "suche ""("""
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(SEARCH(""("",RC[-1]),0)"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L" & loLetzte)
Columns("M:M").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M1").Select
ActiveCell.FormulaR1C1 = "Kürzel"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=TRIM(IF(RC[-1]=0,RC[-2],MID(RC[-2],1,RC[-1]-1)))"
Range("M2").Select
Selection.AutoFill Destination:=Range("M2:M" & loLetzte)
Columns("N:N").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").Select
ActiveCell.FormulaR1C1 = "Abk"
Range("N2").Select
ActiveCell.Formula2R1C1 = "=left(RC[-1],8)"
Selection.AutoFill Destination:=Range("N2:N" & loLetzte)
WBZiel.Sheets("V03 erweitert").Activate
Dim loLetzte1 As Long
With Worksheets("V03 erweitert") 'Blattname
loLetzte1 = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Columns("L:L").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L1").Select
ActiveCell.FormulaR1C1 = "suche ""("""
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(SEARCH(""("",RC[-1]),0)"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L" & loLetzte1)
Columns("M:M").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M1").Select
ActiveCell.FormulaR1C1 = "Kürzel"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=TRIM(IF(RC[-1]=0,RC[-2],MID(RC[-2],1,RC[-1]-1)))"
Range("M2").Select
Selection.AutoFill Destination:=Range("M2:M" & loLetzte1)
Columns("N:N").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").Select
ActiveCell.FormulaR1C1 = "Abk"
Range("N2").Select
ActiveCell.Formula2R1C1 = "=left(RC[-1],8)"
Selection.AutoFill Destination:=Range("N2:N" & loLetzte1)
WBZiel.Sheets("V0405").Activate
Dim loLetzte2 As Long
With Worksheets("V0405") 'Blattname
loLetzte2 = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Columns("L:L").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L1").Select
ActiveCell.FormulaR1C1 = "suche ""("""
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(SEARCH(""("",RC[-1]),0)"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L" & loLetzte2)
Columns("M:M").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M1").Select
ActiveCell.FormulaR1C1 = "Kürzel"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=TRIM(IF(RC[-1]=0,RC[-2],MID(RC[-2],1,RC[-1]-1)))"
Range("M2").Select
Selection.AutoFill Destination:=Range("M2:M" & loLetzte2)
Columns("N:N").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").Select
ActiveCell.FormulaR1C1 = "Abk"
Range("N2").Select
ActiveCell.Formula2R1C1 = "=left(RC[-1],8)"
Selection.AutoFill Destination:=Range("N2:N" & loLetzte2)
Application.EnableEvents = False
Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
'Berechnungen
'Beschriftung
Sheets("Auswertung").Select
Cells.Select
Selection.ClearContents
Range("B2:E2").Select
ActiveCell.FormulaR1C1 = "Rückmeldungen (Gesamtpositionen)"
Range("B4").Select
ActiveCell.FormulaR1C1 = "PD"
Range("C4").Select
ActiveCell.FormulaR1C1 = "V03"
Range("D4").Select
ActiveCell.FormulaR1C1 = "V03 erw."
Range("E4").Select
ActiveCell.FormulaR1C1 = "V05"
Range("F4").Select
ActiveCell.FormulaR1C1 = "Gesamt"
Range("B5").Select
ActiveCell.FormulaR1C1 = "BLN"
Range("B6").Select
ActiveCell.FormulaR1C1 = "CS"
Range("B7").Select
ActiveCell.FormulaR1C1 = "NSZ"
Range("B8").Select
ActiveCell.FormulaR1C1 = "SWE"
Range("B9").Select
ActiveCell.FormulaR1C1 = "I.NP-O-F"
Range("B10").Select
ActiveCell.FormulaR1C1 = "I.NA-O-R"
Range("B11").Select
ActiveCell.FormulaR1C1 = "Summe"
Range("B12").Select
Range("C5").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*BLN*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
Range("C6").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*CS*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
Range("C7").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*NSZ*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
Range("C8").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*SWE*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
Range("C9").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C[8],""*I.NP-O(A)*"",'V03'!C,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)+COUNTIFS('V03'!C11,""*I.NP-O (A)*"",'V03'!C,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)+COUNTIFS('V03'!C11,""*I.NA-O-F*"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C10").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C[8],""*I.NP-O-R*"",'V03'!C3,Eingabe!R5C3,'V03'!C3, Eingabe!R5C4)+COUNTIFS('V03'!C11,""*I.NA-O-R*"",'V03'!C3, Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C11").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("D5").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*BLN*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
Range("D6").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*CS*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
Range("D7").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*NSZ*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
Range("D8").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*SWE*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
Range("D9").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[7],""*I.NP-O(A)*"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)+COUNTIFS('V03 erweitert'!C[7],""*I.NP-O (A)*"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)+COUNTIFS('V03 erweitert'!C[7],""*I.NA-O-F*"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
Range("D10").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[10],""*I.NP-O-R*"",'V03 erweitert'!C3, Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)+COUNTIFS('V03 erweitert'!C[10],""*I.NA-O-R*"",'V03 erweitert'!C3, Eingabe!R5C3,'V03 erweitert'!C3, Eingabe!R5C4)"
Range("D11").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("E5").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*BLN*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
Range("E6").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*CS*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
Range("E7").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*NSZ*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
Range("E8").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*SWE*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
Range("E9").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C[6],""*I.NP-O(A)*"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)+COUNTIFS('V0405'!C[6],""*I.NP-O (A)*"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)+COUNTIFS('V0405'!C[6],""*I.NA-O-F*"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
Range("E10").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C[9],""*I.NP-O-R*"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3, Eingabe!R5C4)+COUNTIFS('V0405'!C[9],""*I.NA-O-R*"",'V0405'!C3, Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
Range("E11").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("F5").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F6").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F7").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F8").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F9").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F10").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F11").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("F12").Select
Range("B15:E15").Select
ActiveCell.FormulaR1C1 = """Nein""-Rückmeldungen V03"
Range("B17").Select
ActiveCell.FormulaR1C1 = "PD"
Range("B18").Select
ActiveCell.FormulaR1C1 = "BLN"
Range("B19").Select
ActiveCell.FormulaR1C1 = "CS"
Range("B20").Select
ActiveCell.FormulaR1C1 = "NSZ"
Range("B21").Select
ActiveCell.FormulaR1C1 = "SWE"
Range("B22").Select
ActiveCell.FormulaR1C1 = "I.NP-O-F"
Range("B23").Select
ActiveCell.FormulaR1C1 = "I.NA-O-R"
Range("B24").Select
ActiveCell.FormulaR1C1 = "Summe"
Range("C17").Select
ActiveCell.FormulaR1C1 = "bauko_3_1_1"
Range("D17").Select
ActiveCell.FormulaR1C1 = "bauko_3_1_2"
Range("E17").Select
ActiveCell.FormulaR1C1 = "bauko_3_1_3"
Range("F17").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_1"
Range("G17").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_2"
Range("H17").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_3"
Range("I17").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_4"
Range("J17").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_5"
Range("K17").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_1"
Range("L17").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_2"
Range("M17").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_3"
Range("N17").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_4"
Range("O17").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_5"
Range("P17").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_6"
Range("Q17").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_7"
Range("R17").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_8"
Range("S17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_1"
Range("T17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_2"
Range("U17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_2_1"
Range("V17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3"
Range("W17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3_1"
Range("X17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3_2"
Range("Y17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3_3"
Range("Z17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4"
Range("AA17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_1"
Range("AB17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_2"
Range("AC17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_3"
Range("AD17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_4"
Range("AE17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_5"
Range("AF17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5"
Range("AG17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5_1"
Range("AH17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5_2"
Range("AI17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5_3"
Range("AJ17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_1"
Range("AK17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_2"
Range("AL17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_3"
Range("AM17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_4"
Range("AN17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_5"
Range("AO17").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_6"
Range("AP17").Select
ActiveCell.FormulaR1C1 = "bauko_4_1"
Range("AQ17").Select
ActiveCell.FormulaR1C1 = "bauko_4_2"
Range("AR17").Select
ActiveCell.FormulaR1C1 = "bauko_4_3"
Range("AS17").Select
ActiveCell.FormulaR1C1 = "bauko_4_4"
Range("AT17").Select
ActiveCell.FormulaR1C1 = "bauko_4_5"
Range("AU17").Select
ActiveCell.FormulaR1C1 = "bauko_4_6"
Range("AV17").Select
ActiveCell.FormulaR1C1 = "bauko_5_1"
Range("C18").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*BLN*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C18").Select
Selection.AutoFill Destination:=Range("C18:AV18"), Type:=xlFillDefault
Range("C19").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*CS*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C19").Select
Selection.AutoFill Destination:=Range("C19:AV19"), Type:=xlFillDefault
Range("C20").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*NSZ*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C20").Select
Selection.AutoFill Destination:=Range("C20:AV20"), Type:=xlFillDefault
Range("C21").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*SWE*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C21").Select
Selection.AutoFill Destination:=Range("C21:AV21"), Type:=xlFillDefault
Range("C22").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C11,""*I.NP-O(A)*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)+COUNTIFS('V03'!C11,""*I.NP-O (A)*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)+COUNTIFS('V03'!C11,""*I.NA-O-F*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C22").Select
Selection.AutoFill Destination:=Range("C22:AV22"), Type:=xlFillDefault
Range("C23").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03'!C14,""*I.NP-O-R*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)+COUNTIFS('V03'!C14,""*I.NA-O-R*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C23").Select
Selection.AutoFill Destination:=Range("C23:AV23"), Type:=xlFillDefault
Range("C24").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("C24").Select
Selection.AutoFill Destination:=Range("C24:AV24"), Type:=xlFillDefault
Range("B26:E26").Select
ActiveCell.FormulaR1C1 = """Nein""-Rückmeldungen V03 erw."
Range("B28").Select
ActiveCell.FormulaR1C1 = "PD"
Range("B29").Select
ActiveCell.FormulaR1C1 = "BLN"
Range("B30").Select
ActiveCell.FormulaR1C1 = "CS"
Range("B31").Select
ActiveCell.FormulaR1C1 = "NSZ"
Range("B32").Select
ActiveCell.FormulaR1C1 = "SWE"
Range("B33").Select
ActiveCell.FormulaR1C1 = "I.NP-O-F"
Range("B34").Select
ActiveCell.FormulaR1C1 = "I.NA-O-R"
Range("B35").Select
ActiveCell.FormulaR1C1 = "Summe"
Range("C28").Select
ActiveCell.FormulaR1C1 = "bauko_3_1_1"
Range("D28").Select
ActiveCell.FormulaR1C1 = "bauko_3_1_2"
Range("E28").Select
ActiveCell.FormulaR1C1 = "bauko_3_1_3"
Range("F28").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_1"
Range("G28").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_2"
Range("H28").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_3"
Range("I28").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_4"
Range("J28").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_5"
Range("K28").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_1"
Range("L28").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_2"
Range("M28").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_3"
Range("N28").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_4"
Range("O28").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_5"
Range("P28").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_6"
Range("Q28").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_7"
Range("R28").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_8"
Range("S28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_1"
Range("T28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_2"
Range("U28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_2_1"
Range("V28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3"
Range("W28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3_1"
Range("X28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3_2"
Range("Y28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3_3"
Range("Z28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4"
Range("AA28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_1"
Range("AB28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_2"
Range("AC28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_3"
Range("AD28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_4"
Range("AE28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_5"
Range("AF28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5"
Range("AG28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5_1"
Range("AH28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5_2"
Range("AI28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5_3"
Range("AJ28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_1"
Range("AK28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_2"
Range("AL28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_3"
Range("AM28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_4"
Range("AN28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_5"
Range("AO28").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_6"
Range("AP28").Select
ActiveCell.FormulaR1C1 = "bauko_4_1"
Range("AQ28").Select
ActiveCell.FormulaR1C1 = "bauko_4_2"
Range("AR28").Select
ActiveCell.FormulaR1C1 = "bauko_4_3"
Range("AS28").Select
ActiveCell.FormulaR1C1 = "bauko_4_4"
Range("AT28").Select
ActiveCell.FormulaR1C1 = "bauko_4_5"
Range("AU28").Select
ActiveCell.FormulaR1C1 = "bauko_4_6"
Range("AV28").Select
ActiveCell.FormulaR1C1 = "bauko_5_1"
Range("AW28").Select
ActiveCell.FormulaR1C1 = "bauko_5_2"
Range("AX28").Select
ActiveCell.FormulaR1C1 = "bauko_5_3"
Range("AY28").Select
ActiveCell.FormulaR1C1 = "bauko_6_1"
Range("AZ28").Select
ActiveCell.FormulaR1C1 = "bauko_6_2"
Range("BA28").Select
ActiveCell.FormulaR1C1 = "bauko_6_3"
Range("C29").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*BLN*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
Range("C29").Select
Selection.AutoFill Destination:=Range("C29:BA29"), Type:=xlFillDefault
Range("C30").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*CS*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
Range("C30").Select
Selection.AutoFill Destination:=Range("C30:BA30"), Type:=xlFillDefault
Range("C31").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*NSZ*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
Range("C31").Select
Selection.AutoFill Destination:=Range("C31:BA31"), Type:=xlFillDefault
Range("C32").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*SWE*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
Range("C32").Select
Selection.AutoFill Destination:=Range("C32:BA32"), Type:=xlFillDefault
Range("C33").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C11,""*I.NP-O(A)*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)+COUNTIFS('V03 erweitert'!C11,""*I.NP-O (A)*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)+COUNTIFS('V03 erweitert'!C11,""*I.NA-O-F*"",'V03 erweitert'!C[23],""nein"",'V03 erwe" & _
"itert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)" & _
""
Range("C33").Select
Selection.AutoFill Destination:=Range("C33:BA33"), Type:=xlFillDefault
Range("C34").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C14,""*I.NP-O-R*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)+COUNTIFS('V03 erweitert'!C14,""*I.NA-O-R*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
Range("C34").Select
Selection.AutoFill Destination:=Range("C34:BA34"), Type:=xlFillDefault
Range("C35").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("C35").Select
Selection.AutoFill Destination:=Range("C35:BA35"), Type:=xlFillDefault
Range("B37:E37").Select
ActiveCell.FormulaR1C1 = """Nein""-Rückmeldungen V05"
Range("B39").Select
ActiveCell.FormulaR1C1 = "PD"
Range("B40").Select
ActiveCell.FormulaR1C1 = "BLN"
Range("B41").Select
ActiveCell.FormulaR1C1 = "CS"
Range("B42").Select
ActiveCell.FormulaR1C1 = "NSZ"
Range("B43").Select
ActiveCell.FormulaR1C1 = "SWE"
Range("B44").Select
ActiveCell.FormulaR1C1 = "I.NP-O-F"
Range("B45").Select
ActiveCell.FormulaR1C1 = "I.NA-O-R"
Range("B46").Select
ActiveCell.FormulaR1C1 = "Summe"
Range("C39").Select
ActiveCell.FormulaR1C1 = "bauko_3_1"
Range("D39").Select
ActiveCell.FormulaR1C1 = "bauko_3_2"
Range("E39").Select
ActiveCell.FormulaR1C1 = "bauko_3_3"
Range("F39").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_1"
Range("G39").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_2"
Range("H39").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3"
Range("I39").Select
ActiveCell.FormulaR1C1 = "bauko_4_1"
Range("J39").Select
ActiveCell.FormulaR1C1 = "bauko_4_2"
Range("K39").Select
ActiveCell.FormulaR1C1 = "bauko_4_3"
Range("L39").Select
ActiveCell.FormulaR1C1 = "bauko_5_1"
Range("M39").Select
ActiveCell.FormulaR1C1 = "bauko_5_2"
Range("N39").Select
ActiveCell.FormulaR1C1 = "bauko_5_3"
Range("O39").Select
ActiveCell.FormulaR1C1 = "bauko_5_4"
Range("P39").Select
ActiveCell.FormulaR1C1 = "bauko_5_5"
Range("C40").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C13,""*BLN*"",'V0405'!C[21],""nein"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
Range("C40").Select
Selection.AutoFill Destination:=Range("C40:P40"), Type:=xlFillDefault
Range("C40:P40").Select
Range("C41").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C13,""*CS*"",'V0405'!C[21],""nein"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
Range("C41").Select
Selection.AutoFill Destination:=Range("C41:P41"), Type:=xlFillDefault
Range("C41:P41").Select
Range("C42").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C13,""*NSZ*"",'V0405'!C[21],""nein"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
Range("C42").Select
Selection.AutoFill Destination:=Range("C42:P42"), Type:=xlFillDefault
Range("C42:P42").Select
Range("C43").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C13,""*SWE*"",'V0405'!C[21],""nein"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
Range("C43").Select
Selection.AutoFill Destination:=Range("C43:P43"), Type:=xlFillDefault
Range("C43:P43").Select
Range("C44").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C11,""*I.NP-O(A)*"",'V0405'!C[21],""nein"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)+COUNTIFS('V0405'!C11,""*I.NP-O (A)*"",'V0405'!C[21],""nein"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)+COUNTIFS('V0405'!C11,""*I.NA-O-F*"",'V0405'!C[21],""nein"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
Range("C44").Select
Selection.AutoFill Destination:=Range("C44:P44"), Type:=xlFillDefault
Range("C44:P44").Select
Range("C45").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('V0405'!C14,""*I.NP-O-R*"",'V0405'!C[21],""nein"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)+COUNTIFS('V0405'!C14,""*I.NA-O-R*"",'V0405'!C[21],""nein"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
Range("C45").Select
Selection.AutoFill Destination:=Range("C45:P45"), Type:=xlFillDefault
Range("C45:P45").Select
Range("C46").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("C46").Select
Selection.AutoFill Destination:=Range("C46:P46"), Type:=xlFillDefault
Range("C46:P46").Select
'Filtern
For PD = 1 To 2
If PD = 1 Then ORT = "*BLN*"
If PD = 2 Then ORT = "*CS*"
If PD = 3 Then ORT = "*NSZ*"
If PD = 4 Then ORT = "*SWE*"
If PD = 5 Then ORT = "*I.NP-O-F*"
If PD = 6 Then ORT = "*I.NA-O-R*"
letztezeile = Sheets("Aufschlüsselung").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 4
'************************** TEMP 1**************************************************
Dim Datum1 As String, Datum2 As String
Datum1 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 3).Text, "=")(1))))
Datum2 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 4).Text, "=")(1))))
ThisWorkbook.Worksheets("V03").Activate
Rows(1).AutoFilter Field:=3, Criteria1:= _
">=" & Datum1, Operator:=xlAnd, Criteria2:="<=" & Datum2
'Nach Netzen filtern
ThisWorkbook.Worksheets("V03").Activate
' ActiveSheet.Range("$A$1:$KW$725").AutoFilter Field:=13, Criteria1:=Array( _
"SWE"), Operator:= _
xlFilterValues
' Selection.AutoFilter Field:=13, Criteria1:="*BLN*", Operator:=xlOr
Selection.AutoFilter Field:=13, Criteria1:=ORT, Operator:=xlOr
Worksheets("V03").Range("M1").AutoFilter Field:=16, VisibleDropDown:=False
'Vorgabe für Aufschlüsselung
Sheets("Aufschlüsselung").Select
Cells.Select
Selection.ClearContents
Worksheets("Aufschlüsselung").Cells.Delete
Range("B3:E3").Select
ActiveCell.FormulaR1C1 = """Nein""-Rückmeldungen V03"
Range("B5").Select
ActiveCell.FormulaR1C1 = "PD " & ORT
Range("C5").Select
ActiveCell.FormulaR1C1 = "bauko_3_1_1"
Range("D5").Select
ActiveCell.FormulaR1C1 = "bauko_3_1_2"
Range("E5").Select
ActiveCell.FormulaR1C1 = "bauko_3_1_3"
Range("F5").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_1"
Range("G5").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_2"
Range("H5").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_3"
Range("I5").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_4"
Range("J5").Select
ActiveCell.FormulaR1C1 = "bauko_3_2_5"
Range("K5").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_1"
Range("L5").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_2"
Range("M5").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_3"
Range("N5").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_4"
Range("O5").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_5"
Range("P5").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_6"
Range("Q5").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_7"
Range("R5").Select
ActiveCell.FormulaR1C1 = "bauko_3_3_8"
Range("S5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_1"
Range("T5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_2"
Range("U5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_2_1"
Range("V5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3"
Range("W5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3_1"
Range("X5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3_2"
Range("Y5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_3_3"
Range("Z5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4"
Range("AA5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_1"
Range("AB5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_2"
Range("AC5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_3"
Range("AD5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_4"
Range("AE5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_4_5"
Range("AF5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5"
Range("AG5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5_1"
Range("AH5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5_2"
Range("AI5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_5_3"
Range("AJ5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_1"
Range("AK5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_2"
Range("AL5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_3"
Range("AM5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_4"
Range("AN5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_5"
Range("AO5").Select
ActiveCell.FormulaR1C1 = "bauko_3_4_6_6"
Range("AP5").Select
ActiveCell.FormulaR1C1 = "bauko_4_1"
Range("AQ5").Select
ActiveCell.FormulaR1C1 = "bauko_4_2"
Range("AR5").Select
ActiveCell.FormulaR1C1 = "bauko_4_3"
Range("AS5").Select
ActiveCell.FormulaR1C1 = "bauko_4_4"
Range("AT5").Select
ActiveCell.FormulaR1C1 = "bauko_4_5"
Range("AU5").Select
ActiveCell.FormulaR1C1 = "bauko_4_6"
Range("AV5").Select
ActiveCell.FormulaR1C1 = "bauko_5_1"
Range("AW5").Select
'ID finden und kopieren
Dim Zeilennr As Integer
Dim Spaltennr As Integer
Dim ID As String
Dim maxZeilen As Integer
Dim maxSpalten As Integer
'Dim AktZeilennr as Integer
Sheets("TEMP1").Select
Cells.Select
Selection.ClearContents
Sheets("V03").Select
Cells.Select
Selection.Copy
Sheets("TEMP1").Select
Cells.Select
ActiveSheet.Paste
maxZeilen = Application.WorksheetFunction.CountA(Range("A:A"))
For Zeilennr = 2 To maxZeilen
For Spaltennr = 27 To 72
If Cells(Zeilennr, Spaltennr) = "nein" Then
ID = Cells(Zeilennr, 1)
' Max. Eintrag in 'Aufschlüsselung, Spalte xx ermitteln
Sheets("Aufschlüsselung").Select
AktZeilennr = ActiveSheet.Cells(1048576, (Spaltennr - 24)).End(xlUp).Row + 1
Sheets("Aufschlüsselung").Cells(AktZeilennr, Spaltennr - 24) = ID
Sheets("TEMP1").Select
End If
Next Spaltennr
Next Zeilennr
'Hier wird die letzte Zeile ermittelt
'Egal in welcher Spalte sich die letzte Zeile befindet
'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben
letztezeile = Sheets("Aufschlüsselung").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 4
'letztezeile = Sheets("Aufschlüsselung").UsedRange.SpecialCells(xlCellTypeLastCell).Row
'************************** TEMP 2**************************************************
'Filtern
Dim Datum3 As String, Datum4 As String
Datum3 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 3).Text, "=")(1))))
Datum4 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 4).Text, "=")(1))))
ThisWorkbook.Worksheets("V03 erweitert").Activate
Rows(1).AutoFilter Field:=3, Criteria1:= _
">=" & Datum1, Operator:=xlAnd, Criteria2:="<=" & Datum2
'Nach Netzen filtern
ThisWorkbook.Worksheets("V03 erweitert").Activate
' ActiveSheet.Range("$A$1:$KW$725").AutoFilter Field:=13, Criteria1:=Array( _
"SWE"), Operator:= _
xlFilterValues
Selection.AutoFilter Field:=13, Criteria1:=ORT, Operator:=xlOr
Sheets("Aufschlüsselung").Select
Cells(letztezeile, 2) = """Nein""-Rückmeldungen V03 erw."
Cells(letztezeile + 2, 2) = "PD " & ORT
Cells(letztezeile + 2, 3) = "bauko_3_1_1"
Cells(letztezeile + 2, 4) = "bauko_3_1_2"
Cells(letztezeile + 2, 5) = "bauko_3_1_3"
Cells(letztezeile + 2, 6) = "bauko_3_2_1"
Cells(letztezeile + 2, 7) = "bauko_3_2_2"
Cells(letztezeile + 2, 8) = "bauko_3_2_3"
Cells(letztezeile + 2, 9) = "bauko_3_2_4"
Cells(letztezeile + 2, 10) = "bauko_3_2_5"
Cells(letztezeile + 2, 11) = "bauko_3_3_1"
Cells(letztezeile + 2, 12) = "bauko_3_3_2"
Cells(letztezeile + 2, 13) = "bauko_3_3_3"
Cells(letztezeile + 2, 14) = "bauko_3_3_4"
Cells(letztezeile + 2, 15) = "bauko_3_3_5"
Cells(letztezeile + 2, 16) = "bauko_3_3_6"
Cells(letztezeile + 2, 17) = "bauko_3_3_7"
Cells(letztezeile + 2, 18) = "bauko_3_3_8"
Cells(letztezeile + 2, 19) = "bauko_3_4_1"
Cells(letztezeile + 2, 20) = "bauko_3_4_2"
Cells(letztezeile + 2, 21) = "bauko_3_4_2_1"
Cells(letztezeile + 2, 22) = "bauko_3_4_3"
Cells(letztezeile + 2, 23) = "bauko_3_4_3_1"
Cells(letztezeile + 2, 24) = "bauko_3_4_3_2"
Cells(letztezeile + 2, 25) = "bauko_3_4_3_3"
Cells(letztezeile + 2, 26) = "bauko_3_4_4"
Cells(letztezeile + 2, 27) = "bauko_3_4_4_1"
Cells(letztezeile + 2, 28) = "bauko_3_4_4_2"
Cells(letztezeile + 2, 29) = "bauko_3_4_4_3"
Cells(letztezeile + 2, 30) = "bauko_3_4_4_4"
Cells(letztezeile + 2, 31) = "bauko_3_4_4_5"
Cells(letztezeile + 2, 32) = "bauko_3_4_5"
Cells(letztezeile + 2, 33) = "bauko_3_4_5_1"
Cells(letztezeile + 2, 34) = "bauko_3_4_5_2"
Cells(letztezeile + 2, 35) = "bauko_3_4_5_3"
Cells(letztezeile + 2, 36) = "bauko_3_4_6_1"
Cells(letztezeile + 2, 37) = "bauko_3_4_6_2"
Cells(letztezeile + 2, 38) = "bauko_3_4_6_3"
Cells(letztezeile + 2, 39) = "bauko_3_4_6_4"
Cells(letztezeile + 2, 40) = "bauko_3_4_6_5"
Cells(letztezeile + 2, 41) = "bauko_3_4_6_6"
Cells(letztezeile + 2, 42) = "bauko_4_1"
Cells(letztezeile + 2, 43) = "bauko_4_2"
Cells(letztezeile + 2, 44) = "bauko_4_3"
Cells(letztezeile + 2, 45) = "bauko_4_4"
Cells(letztezeile + 2, 46) = "bauko_4_5"
Cells(letztezeile + 2, 47) = "bauko_4_6"
Cells(letztezeile + 2, 48) = "bauko_5_1"
Cells(letztezeile + 2, 49) = "bauko_5_2"
Cells(letztezeile + 2, 50) = "bauko_5_3"
Cells(letztezeile + 2, 51) = "bauko_6_1"
Cells(letztezeile + 2, 52) = "bauko_6_2"
Cells(letztezeile + 2, 53) = "bauko_6_3"
'ID finden und kopieren
'Dim Zeilennr As Integer
'Dim Spaltennr As Integer
'Dim ID As String
'Dim maxZeilen As Integer
'Dim maxSpalten As Integer
'Dim AktZeilennr as Integer
Sheets("TEMP2").Select
Cells.Select
Selection.ClearContents
Sheets("V03 erweitert").Select
Cells.Select
Selection.Copy
Sheets("TEMP2").Select
Cells.Select
ActiveSheet.Paste
maxZeilen = Application.WorksheetFunction.CountA(Range("A:A"))
For Zeilennr = 2 To maxZeilen
For Spaltennr = 26 To 76
If Cells(Zeilennr, Spaltennr) = "nein" Then
ID = Cells(Zeilennr, 1)
' Max. Eintrag in 'Aufschlüsselung, Spalte xx ermitteln
Sheets("Aufschlüsselung").Select
AktZeilennr = ActiveSheet.Cells(1048576, (Spaltennr - 23)).End(xlUp).Row + 1
Sheets("Aufschlüsselung").Cells(AktZeilennr, Spaltennr - 23) = ID
Sheets("TEMP2").Select
End If
Next Spaltennr
Next Zeilennr
'Hier wird die letzte Zeile ermittelt
'Egal in welcher Spalte sich die letzte Zeile befindet
'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben
letztezeile = Sheets("Aufschlüsselung").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 4
'************************** TEMP 3**************************************************
'Filtern
Dim Datum5 As String, Datum6 As String
Datum5 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 3).Text, "=")(1))))
Datum6 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 4).Text, "=")(1))))
ThisWorkbook.Worksheets("V0405").Activate
Rows(1).AutoFilter Field:=3, Criteria1:= _
">=" & Datum1, Operator:=xlAnd, Criteria2:="<=" & Datum2
'Nach Netzen filtern
ThisWorkbook.Worksheets("V0405").Activate
' ActiveSheet.Range("$A$1:$KW$725").AutoFilter Field:=13, Criteria1:=Array( _
"SWE"), Operator:= _
xlFilterValues
Selection.AutoFilter Field:=13, Criteria1:=ORT, Operator:=xlOr
Sheets("Aufschlüsselung").Select
Cells(letztezeile, 2) = """Nein""-Rückmeldungen V04 V05"
Cells(letztezeile + 2, 2) = "PD " & ORT
Cells(letztezeile + 2, 3) = "bauko_3_1"
Cells(letztezeile + 2, 4) = "bauko_3_2"
Cells(letztezeile + 2, 5) = "bauko_3_3"
Cells(letztezeile + 2, 6) = "bauko_3_4_1"
Cells(letztezeile + 2, 7) = "bauko_3_4_2"
Cells(letztezeile + 2, 8) = "bauko_3_4_3"
Cells(letztezeile + 2, 9) = "bauko_4_1"
Cells(letztezeile + 2, 10) = "bauko_4_2"
Cells(letztezeile + 2, 11) = "bauko_4_3"
Cells(letztezeile + 2, 12) = "bauko_5_1"
Cells(letztezeile + 2, 13) = "bauko_5_2"
Cells(letztezeile + 2, 14) = "bauko_5_3"
Cells(letztezeile + 2, 15) = "bauko_5_4"
Cells(letztezeile + 2, 16) = "bauko_5_5"
'ID finden und kopieren
'Dim Zeilennr As Integer
'Dim Spaltennr As Integer
'Dim ID As String
'Dim maxZeilen As Integer
'Dim maxSpalten As Integer
'Dim AktZeilennr as Integer
Sheets("TEMP3").Select
Cells.Select
Selection.ClearContents
Sheets("V0405").Select
Cells.Select
Selection.Copy
Sheets("TEMP3").Select
Cells.Select
ActiveSheet.Paste
maxZeilen = Application.WorksheetFunction.CountA(Range("A:A"))
For Zeilennr = 2 To maxZeilen
For Spaltennr = 24 To 37
If Cells(Zeilennr, Spaltennr) = "nein" Then
ID = Cells(Zeilennr, 1)
' Max. Eintrag in 'Aufschlüsselung, Spalte xx ermitteln
Sheets("Aufschlüsselung").Select
AktZeilennr = ActiveSheet.Cells(1048576, (Spaltennr - 21)).End(xlUp).Row + 1
Sheets("Aufschlüsselung").Cells(AktZeilennr, Spaltennr - 21) = ID
Sheets("TEMP3").Select
End If
Next Spaltennr
Next Zeilennr
'Hier wird die letzte Zeile ermittelt
'Egal in welcher Spalte sich die letzte Zeile befindet
'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben
' letztezeile = Sheets("Aufschlüsselung").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 4
Next PD
End Sub
|