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

Ansicht des Beitrags:
Von:
Jörg
Datum:
12.04.2021 18:16:32
Views:
136
Rating: Antwort:
  Ja
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
Rot VBA-Makro führt zu Excel-Abbruch
12.04.2021 18:16:32 Jörg
NotSolved
12.04.2021 19:54:55 ralf_b
NotSolved
12.04.2021 20:48:52 Jörg
NotSolved
12.04.2021 22:33:43 ralf_b
NotSolved
12.04.2021 23:10:10 Gast80927
NotSolved
12.04.2021 23:46:34 ralf_b
NotSolved
13.04.2021 07:52:27 Jörg
NotSolved
13.04.2021 14:52:30 Nobody
NotSolved
13.04.2021 16:52:58 Jörg
NotSolved
13.04.2021 17:58:59 Nobody
NotSolved
13.04.2021 18:02:50 Jörg
NotSolved
14.04.2021 19:19:28 Nobody
NotSolved