|
Hallo
dann schau bitte mal wie weit der bereinigte Code laueft und wo er abbricht. Die Select sind bis auf wenigs Sheet.Select alle raus.
mfg
Sub Baustellenkontrollen()
Dim WBZiel As Workbook, ExportDatei As Variant
Dim WBQuelle As Workbook, WSZiel As Worksheet
Dim wks As Worksheet, loLetzte1 As Long
Set WBZiel = ThisWorkbook
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Sheets("V03").Select
Cells.ClearContents
With ActiveSheet
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
Else
.UsedRange.AutoFilter
End If
End With
Sheets("V03 erweitert").Select
Cells.ClearContents
With ActiveSheet
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
Else
.UsedRange.AutoFilter
End If
End With
'Datei öffnen, Dialog anbieten
ExportDatei = Application.GetOpenFilename("Excel-Dateien, *.xlsx*", , "Bitte die Datei zum Kopieren öffnen ..")
ExportDatei = CStr(ExportDatei)
If ExportDatei = False Then Exit Sub 'oder Empty ??
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")
.Sheets("V03 erweitert").Range("A1:KT9000").Copy WBZiel.Sheets("V03 erweitert").Range("A1")
.Sheets("V0405").Range("A1:KT9000").Copy WBZiel.Sheets("V0405").Range("A1")
.Close savechanges:=False
End With
WBZiel.Sheets("V03").Activate
loLetzte = Cells(.Rows.Count, 1).End(xlUp).Row
Columns("L:L").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L1").FormulaR1C1 = "suche ""("""
Range("L2").FormulaR1C1 = "=IFERROR(SEARCH(""("",RC[-1]),0)"
Range("L2").AutoFill Destination:=Range("L2:L" & loLetzte)
Columns("M:M").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M1").FormulaR1C1 = "Kürzel"
Range("M2").FormulaR1C1 = "=TRIM(IF(RC[-1]=0,RC[-2],MID(RC[-2],1,RC[-1]-1)))"
Range("M2").AutoFill Destination:=Range("M2:M" & loLetzte)
Columns("N:N").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").FormulaR1C1 = "Abk"
Range("N2").Formula2R1C1 = "=left(RC[-1],8)"
Range("N2").AutoFill Destination:=Range("N2:N" & loLetzte)
WBZiel.Sheets("V03 erweitert").Activate
loLetzte1 = Cells(.Rows.Count, 1).End(xlUp).Row
Columns("L:L").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L1").FormulaR1C1 = "suche ""("""
Range("L2").FormulaR1C1 = "=IFERROR(SEARCH(""("",RC[-1]),0)"
Range("L2").AutoFill Destination:=Range("L2:L" & loLetzte1)
Columns("M:M").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M1").FormulaR1C1 = "Kürzel"
Range("M2").FormulaR1C1 = "=TRIM(IF(RC[-1]=0,RC[-2],MID(RC[-2],1,RC[-1]-1)))"
Range("M2").AutoFill Destination:=Range("M2:M" & loLetzte1)
Columns("N:N").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").FormulaR1C1 = "Abk"
Range("N2").Formula2R1C1 = "=left(RC[-1],8)"
Range("N2").AutoFill Destination:=Range("N2:N" & loLetzte1)
WBZiel.Sheets("V0405").Activate
loLetzte2 = Cells(.Rows.Count, 1).End(xlUp).Row
Columns("L:L").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L1").FormulaR1C1 = "suche ""("""
Range("L2").FormulaR1C1 = "=IFERROR(SEARCH(""("",RC[-1]),0)"
Range("L2").AutoFill Destination:=Range("L2:L" & loLetzte2)
Columns("M:M").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M1").FormulaR1C1 = "Kürzel"
Range("M2").FormulaR1C1 = "=TRIM(IF(RC[-1]=0,RC[-2],MID(RC[-2],1,RC[-1]-1)))"
Range("M2").AutoFill Destination:=Range("M2:M" & loLetzte2)
Columns("N:N").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").FormulaR1C1 = "Abk"
Range("N2").Formula2R1C1 = "=left(RC[-1],8)"
Range("N2").AutoFill Destination:=Range("N2:N" & loLetzte2)
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
'Berechnungen
'Beschriftung
Sheets("Auswertung").Select
Cells.ClearContents
'** Range A1??? war ActiveCell!!
Range("A1").FormulaR1C1 = "Rückmeldungen (Gesamtpositionen)"
Range("B4").FormulaR1C1 = "PD"
Range("C4").FormulaR1C1 = "V03"
Range("D4").FormulaR1C1 = "V03 erw."
Range("E4").FormulaR1C1 = "V05"
Range("F4").FormulaR1C1 = "Gesamt"
Range("B5").FormulaR1C1 = "BLN"
Range("B6").FormulaR1C1 = "CS"
Range("B7").FormulaR1C1 = "NSZ"
Range("B8").FormulaR1C1 = "SWE"
Range("B9").FormulaR1C1 = "I.NP-O-F"
Range("B10").FormulaR1C1 = "I.NA-O-R"
Range("B11").FormulaR1C1 = "Summe"
Range("C5").FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*BLN*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
Range("C6").FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*CS*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
Range("C7").FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*NSZ*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
Range("C8").FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*SWE*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
Range("C9").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").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").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("D5").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*BLN*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
Range("D6").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*CS*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
Range("D7").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*NSZ*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
Range("D8").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*SWE*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
Range("D9").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").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").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("E5").FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*BLN*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
Range("E6").FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*CS*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
Range("E7").FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*NSZ*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
Range("E8").FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*SWE*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
Range("E9").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").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").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("F5").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F6").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F7").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F8").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F9").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F10").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F11").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("B15:E15").FormulaR1C1 = """Nein""-Rückmeldungen V03"
Range("B17").FormulaR1C1 = "PD"
Range("B18").FormulaR1C1 = "BLN"
Range("B19").FormulaR1C1 = "CS"
Range("B20").FormulaR1C1 = "NSZ"
Range("B21").FormulaR1C1 = "SWE"
Range("B22").FormulaR1C1 = "I.NP-O-F"
Range("B23").FormulaR1C1 = "I.NA-O-R"
Range("B24").FormulaR1C1 = "Summe"
Range("C17").FormulaR1C1 = "bauko_3_1_1"
Range("D17").FormulaR1C1 = "bauko_3_1_2"
Range("E17").FormulaR1C1 = "bauko_3_1_3"
Range("F17").FormulaR1C1 = "bauko_3_2_1"
Range("G17").FormulaR1C1 = "bauko_3_2_2"
Range("H17").FormulaR1C1 = "bauko_3_2_3"
Range("I17").FormulaR1C1 = "bauko_3_2_4"
Range("J17").FormulaR1C1 = "bauko_3_2_5"
Range("K17").FormulaR1C1 = "bauko_3_3_1"
Range("L17").FormulaR1C1 = "bauko_3_3_2"
Range("M17").FormulaR1C1 = "bauko_3_3_3"
Range("N17").FormulaR1C1 = "bauko_3_3_4"
Range("O17").FormulaR1C1 = "bauko_3_3_5"
Range("P17").FormulaR1C1 = "bauko_3_3_6"
Range("Q17").FormulaR1C1 = "bauko_3_3_7"
Range("R17").FormulaR1C1 = "bauko_3_3_8"
Range("S17").FormulaR1C1 = "bauko_3_4_1"
Range("T17").FormulaR1C1 = "bauko_3_4_2"
Range("U17").FormulaR1C1 = "bauko_3_4_2_1"
Range("V17").FormulaR1C1 = "bauko_3_4_3"
Range("W17").FormulaR1C1 = "bauko_3_4_3_1"
Range("X17").FormulaR1C1 = "bauko_3_4_3_2"
Range("Y17").FormulaR1C1 = "bauko_3_4_3_3"
Range("Z17").FormulaR1C1 = "bauko_3_4_4"
Range("AA17").FormulaR1C1 = "bauko_3_4_4_1"
Range("AB17").FormulaR1C1 = "bauko_3_4_4_2"
Range("AC17").FormulaR1C1 = "bauko_3_4_4_3"
Range("AD17").FormulaR1C1 = "bauko_3_4_4_4"
Range("AE17").FormulaR1C1 = "bauko_3_4_4_5"
Range("AF17").FormulaR1C1 = "bauko_3_4_5"
Range("AG17").FormulaR1C1 = "bauko_3_4_5_1"
Range("AH17").FormulaR1C1 = "bauko_3_4_5_2"
Range("AI17").FormulaR1C1 = "bauko_3_4_5_3"
Range("AJ17").FormulaR1C1 = "bauko_3_4_6_1"
Range("AK17").FormulaR1C1 = "bauko_3_4_6_2"
Range("AL17").FormulaR1C1 = "bauko_3_4_6_3"
Range("AM17").FormulaR1C1 = "bauko_3_4_6_4"
Range("AN17").FormulaR1C1 = "bauko_3_4_6_5"
Range("AO17").FormulaR1C1 = "bauko_3_4_6_6"
Range("AP17").FormulaR1C1 = "bauko_4_1"
Range("AQ17").FormulaR1C1 = "bauko_4_2"
Range("AR17").FormulaR1C1 = "bauko_4_3"
Range("AS17").FormulaR1C1 = "bauko_4_4"
Range("AT17").FormulaR1C1 = "bauko_4_5"
Range("AU17").FormulaR1C1 = "bauko_4_6"
Range("AV17").FormulaR1C1 = "bauko_5_1"
Range("C18").FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*BLN*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C18").AutoFill Destination:=Range("C18:AV18"), Type:=xlFillDefault
Range("C19").FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*CS*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C19").AutoFill Destination:=Range("C19:AV19"), Type:=xlFillDefault
Range("C20").FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*NSZ*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C20").AutoFill Destination:=Range("C20:AV20"), Type:=xlFillDefault
Range("C21").FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*SWE*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
Range("C21").AutoFill Destination:=Range("C21:AV21"), Type:=xlFillDefault
Range("C22").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").AutoFill Destination:=Range("C22:AV22"), Type:=xlFillDefault
Range("C23").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").AutoFill Destination:=Range("C23:AV23"), Type:=xlFillDefault
Range("C24").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("C24").AutoFill Destination:=Range("C24:AV24"), Type:=xlFillDefault
Range("B26:E26").FormulaR1C1 = """Nein""-Rückmeldungen V03 erw."
Range("B28").FormulaR1C1 = "PD"
Range("B29").FormulaR1C1 = "BLN"
Range("B30").FormulaR1C1 = "CS"
Range("B31").FormulaR1C1 = "NSZ"
Range("B32").FormulaR1C1 = "SWE"
Range("B33").FormulaR1C1 = "I.NP-O-F"
Range("B34").FormulaR1C1 = "I.NA-O-R"
Range("B35").FormulaR1C1 = "Summe"
Range("C28").FormulaR1C1 = "bauko_3_1_1"
Range("D28").FormulaR1C1 = "bauko_3_1_2"
Range("E28").FormulaR1C1 = "bauko_3_1_3"
Range("F28").FormulaR1C1 = "bauko_3_2_1"
Range("G28").FormulaR1C1 = "bauko_3_2_2"
Range("H28").FormulaR1C1 = "bauko_3_2_3"
Range("I28").FormulaR1C1 = "bauko_3_2_4"
Range("J28").FormulaR1C1 = "bauko_3_2_5"
Range("K28").FormulaR1C1 = "bauko_3_3_1"
Range("L28").FormulaR1C1 = "bauko_3_3_2"
Range("M28").FormulaR1C1 = "bauko_3_3_3"
Range("N28").FormulaR1C1 = "bauko_3_3_4"
Range("O28").FormulaR1C1 = "bauko_3_3_5"
Range("P28").FormulaR1C1 = "bauko_3_3_6"
Range("Q28").FormulaR1C1 = "bauko_3_3_7"
Range("R28").FormulaR1C1 = "bauko_3_3_8"
Range("S28").FormulaR1C1 = "bauko_3_4_1"
Range("T28").FormulaR1C1 = "bauko_3_4_2"
Range("U28").FormulaR1C1 = "bauko_3_4_2_1"
Range("V28").FormulaR1C1 = "bauko_3_4_3"
Range("W28").FormulaR1C1 = "bauko_3_4_3_1"
Range("X28").FormulaR1C1 = "bauko_3_4_3_2"
Range("Y28").FormulaR1C1 = "bauko_3_4_3_3"
Range("Z28").FormulaR1C1 = "bauko_3_4_4"
Range("AA28").FormulaR1C1 = "bauko_3_4_4_1"
Range("AB28").FormulaR1C1 = "bauko_3_4_4_2"
Range("AC28").FormulaR1C1 = "bauko_3_4_4_3"
Range("AD28").FormulaR1C1 = "bauko_3_4_4_4"
Range("AE28").FormulaR1C1 = "bauko_3_4_4_5"
Range("AF28").FormulaR1C1 = "bauko_3_4_5"
Range("AG28").FormulaR1C1 = "bauko_3_4_5_1"
Range("AH28").FormulaR1C1 = "bauko_3_4_5_2"
Range("AI28").FormulaR1C1 = "bauko_3_4_5_3"
Range("AJ28").FormulaR1C1 = "bauko_3_4_6_1"
Range("AK28").FormulaR1C1 = "bauko_3_4_6_2"
Range("AL28").FormulaR1C1 = "bauko_3_4_6_3"
Range("AM28").FormulaR1C1 = "bauko_3_4_6_4"
Range("AN28").FormulaR1C1 = "bauko_3_4_6_5"
Range("AO28").FormulaR1C1 = "bauko_3_4_6_6"
Range("AP28").FormulaR1C1 = "bauko_4_1"
Range("AQ28").FormulaR1C1 = "bauko_4_2"
Range("AR28").FormulaR1C1 = "bauko_4_3"
Range("AS28").FormulaR1C1 = "bauko_4_4"
Range("AT28").FormulaR1C1 = "bauko_4_5"
Range("AU28").FormulaR1C1 = "bauko_4_6"
Range("AV28").FormulaR1C1 = "bauko_5_1"
Range("AW28").FormulaR1C1 = "bauko_5_2"
Range("AX28").FormulaR1C1 = "bauko_5_3"
Range("AY28").FormulaR1C1 = "bauko_6_1"
Range("AZ28").FormulaR1C1 = "bauko_6_2"
Range("BA28").FormulaR1C1 = "bauko_6_3"
Range("C29").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*BLN*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
Range("C29").AutoFill Destination:=Range("C29:BA29"), Type:=xlFillDefault
Range("C30").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*CS*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
Range("C30").AutoFill Destination:=Range("C30:BA30"), Type:=xlFillDefault
Range("C31").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*NSZ*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
Range("C31").AutoFill Destination:=Range("C31:BA31"), Type:=xlFillDefault
Range("C32").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*SWE*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
Range("C32").AutoFill Destination:=Range("C32:BA32"), Type:=xlFillDefault
Range("C33").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").AutoFill Destination:=Range("C33:BA33"), Type:=xlFillDefault
Range("C34").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").AutoFill Destination:=Range("C34:BA34"), Type:=xlFillDefault
Range("C35").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("C35").AutoFill Destination:=Range("C35:BA35"), Type:=xlFillDefault
Range("B37:E37").FormulaR1C1 = """Nein""-Rückmeldungen V05"
Range("B39").FormulaR1C1 = "PD"
Range("B40").FormulaR1C1 = "BLN"
Range("B41").FormulaR1C1 = "CS"
Range("B42").FormulaR1C1 = "NSZ"
Range("B43").FormulaR1C1 = "SWE"
Range("B44").FormulaR1C1 = "I.NP-O-F"
Range("B45").FormulaR1C1 = "I.NA-O-R"
Range("B46").FormulaR1C1 = "Summe"
Range("C39").FormulaR1C1 = "bauko_3_1"
Range("D39").FormulaR1C1 = "bauko_3_2"
Range("E39").FormulaR1C1 = "bauko_3_3"
Range("F39").FormulaR1C1 = "bauko_3_4_1"
Range("G39").FormulaR1C1 = "bauko_3_4_2"
Range("H39").FormulaR1C1 = "bauko_3_4_3"
Range("I39").FormulaR1C1 = "bauko_4_1"
Range("J39").FormulaR1C1 = "bauko_4_2"
Range("K39").FormulaR1C1 = "bauko_4_3"
Range("L39").FormulaR1C1 = "bauko_5_1"
Range("M39").FormulaR1C1 = "bauko_5_2"
Range("N39").FormulaR1C1 = "bauko_5_3"
Range("O39").FormulaR1C1 = "bauko_5_4"
Range("P39").FormulaR1C1 = "bauko_5_5"
Range("C40").FormulaR1C1 = "=COUNTIFS('V0405'!C13,""*BLN*"",'V0405'!C[21],""nein"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
Range("C40").AutoFill Destination:=Range("C40:P40"), Type:=xlFillDefault
Range("C41").AutoFill Destination:=Range("C41:P41"), Type:=xlFillDefault
Range("C42").AutoFill Destination:=Range("C42:P42"), Type:=xlFillDefault
Range("C43").AutoFill Destination:=Range("C43:P43"), Type:=xlFillDefault
Range("C44").AutoFill Destination:=Range("C44:P44"), Type:=xlFillDefault
Range("C45").AutoFill Destination:=Range("C45:P45"), Type:=xlFillDefault
ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("C46").AutoFill Destination:=Range("C46:P46"), Type:=xlFillDefault
'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
'Nach Netzen filtern
ThisWorkbook.Worksheets("V03").Activate
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
Sheets("Aufschlüsselung").ClearContents
Range("B3:E3").FormulaR1C1 = """Nein""-Rückmeldungen V03"
Range("B5").FormulaR1C1 = "PD " & ORT
Range("C5").FormulaR1C1 = "bauko_3_1_1"
Range("D5").FormulaR1C1 = "bauko_3_1_2"
Range("E5").FormulaR1C1 = "bauko_3_1_3"
Range("F5").FormulaR1C1 = "bauko_3_2_1"
Range("G5").FormulaR1C1 = "bauko_3_2_2"
Range("H5").FormulaR1C1 = "bauko_3_2_3"
Range("I5").FormulaR1C1 = "bauko_3_2_4"
Range("J5").FormulaR1C1 = "bauko_3_2_5"
Range("K5").FormulaR1C1 = "bauko_3_3_1"
Range("L5").FormulaR1C1 = "bauko_3_3_2"
Range("M5").FormulaR1C1 = "bauko_3_3_3"
Range("N5").FormulaR1C1 = "bauko_3_3_4"
Range("O5").FormulaR1C1 = "bauko_3_3_5"
Range("P5").FormulaR1C1 = "bauko_3_3_6"
Range("Q5").FormulaR1C1 = "bauko_3_3_7"
Range("R5").FormulaR1C1 = "bauko_3_3_8"
Range("S5").FormulaR1C1 = "bauko_3_4_1"
Range("T5").FormulaR1C1 = "bauko_3_4_2"
Range("U5").FormulaR1C1 = "bauko_3_4_2_1"
Range("V5").FormulaR1C1 = "bauko_3_4_3"
Range("W5").FormulaR1C1 = "bauko_3_4_3_1"
Range("X5").FormulaR1C1 = "bauko_3_4_3_2"
Range("Y5").FormulaR1C1 = "bauko_3_4_3_3"
Range("Z5").FormulaR1C1 = "bauko_3_4_4"
Range("AA5").FormulaR1C1 = "bauko_3_4_4_1"
Range("AB5").FormulaR1C1 = "bauko_3_4_4_2"
Range("AC5").FormulaR1C1 = "bauko_3_4_4_3"
Range("AD5").FormulaR1C1 = "bauko_3_4_4_4"
Range("AE5").FormulaR1C1 = "bauko_3_4_4_5"
Range("AF5").FormulaR1C1 = "bauko_3_4_5"
Range("AG5").FormulaR1C1 = "bauko_3_4_5_1"
Range("AH5").FormulaR1C1 = "bauko_3_4_5_2"
Range("AI5").FormulaR1C1 = "bauko_3_4_5_3"
Range("AJ5").FormulaR1C1 = "bauko_3_4_6_1"
Range("AK5").FormulaR1C1 = "bauko_3_4_6_2"
Range("AL5").FormulaR1C1 = "bauko_3_4_6_3"
Range("AM5").FormulaR1C1 = "bauko_3_4_6_4"
Range("AN5").FormulaR1C1 = "bauko_3_4_6_5"
Range("AO5").FormulaR1C1 = "bauko_3_4_6_6"
Range("AP5").FormulaR1C1 = "bauko_4_1"
Range("AQ5").FormulaR1C1 = "bauko_4_2"
Range("AR5").FormulaR1C1 = "bauko_4_3"
Range("AS5").FormulaR1C1 = "bauko_4_4"
Range("AT5").FormulaR1C1 = "bauko_4_5"
Range("AU5").FormulaR1C1 = "bauko_4_6"
Range("AV5").FormulaR1C1 = "bauko_5_1"
'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.ClearContents
Sheets("V03").Cells.Copy
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
Sheets("Aufschlüsselung").Cells(AktZeilennr, Spaltennr - 24) = ID
Sheets("TEMP1").Select
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
'Nach Netzen filtern
ThisWorkbook.Worksheets("V03 erweitert").Activate
Sheets("TEMP1").AutoFilter Field:=13, Criteria1:=ORT, Operator:=xlOr
Sheets("Aufschlüsselung").Select
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
Sheets("TEMP2").ClearContents
Sheets("V03 erweitert").Cells.Copy
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
Sheets("Aufschlüsselung").Cells(AktZeilennr, Spaltennr - 23) = ID
Sheets("TEMP2").Select
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
'Nach Netzen filtern
ThisWorkbook.Worksheets("V0405").Activate
Sheets("TEMP2").AutoFilter Field:=13, Criteria1:=ORT, Operator:=xlOr
Sheets("Aufschlüsselung").Select
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
Sheets("TEMP3").ClearContents
Sheets("V0405").Cells.Copy
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
Sheets("Aufschlüsselung").Cells(AktZeilennr, Spaltennr - 21) = ID
Sheets("TEMP3").Select
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
Application.EnableEvents = True
End Sub
|