VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
VBA-Makro führt zu Excel-Abbruch	12.04.2021 18:16:32	Jörg
VBA-Makro führt zu Excel-Abbruch	12.04.2021 19:54:55	ralf_b
VBA-Makro führt zu Excel-Abbruch	12.04.2021 20:48:52	Jörg
sorry	12.04.2021 22:33:43	ralf_b
sorry	12.04.2021 23:10:10	Gast80927
sorry	12.04.2021 23:46:34	ralf_b
Danke	13.04.2021 07:52:27	Jörg
Danke	13.04.2021 14:52:30	Nobody
Danke	13.04.2021 16:52:58	Jörg
Danke	13.04.2021 17:58:59	Nobody
Danke	13.04.2021 18:02:50	Jörg
Danke	14.04.2021 19:19:28	Nobody

Ansicht des Beitrags:

Von:
Jörg

Datum:
12.04.2021 18:16:32

Views:
1117

Rating:

Antwort:

Thema:
VBA-Makro führt zu Excel-Abbruch

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

Ihre Antwort

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema:		Name:		Email:

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema	Datum	Von Nutzer	Rating	Antwort
VBA-Makro führt zu Excel-Abbruch	12.04.2021 18:16:32	Jörg
VBA-Makro führt zu Excel-Abbruch	12.04.2021 19:54:55	ralf_b
VBA-Makro führt zu Excel-Abbruch	12.04.2021 20:48:52	Jörg
sorry	12.04.2021 22:33:43	ralf_b
sorry	12.04.2021 23:10:10	Gast80927
sorry	12.04.2021 23:46:34	ralf_b
Danke	13.04.2021 07:52:27	Jörg
Danke	13.04.2021 14:52:30	Nobody
Danke	13.04.2021 16:52:58	Jörg
Danke	13.04.2021 17:58:59	Nobody
Danke	13.04.2021 18:02:50	Jörg
Danke	14.04.2021 19:19:28	Nobody