Hallo zusammen,

ich habe in Excel eine "Datenbank" programmiert. Dieser funktioniert einwadnfrei aber nach ein paar Tagen kann ich die datei nicht mehr öffnen. Vermutlich wurde ein Makro falsch programmiert. Ledier sind meine VBA-Kentnisse nicht so hoch. Daher bin ich auf eure Hilfe angewiesen.
vielen Dank!  

Ich pick ein paar Makros raus, wo evtl die Fehler liegen.

1.

Sub Maschinenpark2()
    
     With Sheets("MAE2")
        .Range("A9", .UsedRange.SpecialCells(xlCellTypeLastCell)).ClearContents
      End With
      With Sheets("457")
        .Range("A9", .UsedRange.SpecialCells(xlCellTypeLastCell)).Copy _
        Sheets("MAE2").Range("A" & Rows.Count).End(xlUp).Offset(1)
      End With
       With Sheets("454")
        .Range("A9", .UsedRange.SpecialCells(xlCellTypeLastCell)).Copy _
        Sheets("MAE2").Range("A" & Rows.Count).End(xlUp).Offset(1)
      End With
    
      Sheets("MAE2").Select
      
End Sub

2.

Sub Sammeln()

Dim rng As Range
Dim rng2 As Range
Dim DeinWert As Variant
Dim first As String

DeinWert = InputBox(prompt:="Geben Sie ein Datum:", Default:=Format("dd.mm.yyyy"))


ActiveWorkbook.Worksheets("Zusammenfassung").Range("A9:K65536").Clear

If DeinWert = "" Then Exit Sub
   DeinWert = CDate(DeinWert)
   
   
   
   
Set rng = Worksheets("668").Range("G:G").Find(DeinWert)
If rng Is Nothing Then
Else
  first = rng.Address
    rng.EntireRow.Copy
    Worksheets("Zusammenfassung").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
End If

Set rng = Worksheets("591").Range("G:G").Find(DeinWert)
If rng Is Nothing Then
Else
  first = rng.Address
    rng.EntireRow.Copy
    Worksheets("Zusammenfassung").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
End If

Set rng = Worksheets("689").Range("G:G").Find(DeinWert)
If rng Is Nothing Then
Else
  first = rng.Address
    rng.EntireRow.Copy
    Worksheets("Zusammenfassung").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
End If
   
Set rng = Worksheets("688").Range("G:G").Find(DeinWert)
If rng Is Nothing Then
Else
  first = rng.Address
    rng.EntireRow.Copy
    Worksheets("Zusammenfassung").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
End If

Set rng = Worksheets("704").Range("G:G").Find(DeinWert)
If rng Is Nothing Then
Else
  first = rng.Address
    rng.EntireRow.Copy
    Worksheets("Zusammenfassung").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
End If

Set rng = Worksheets("651").Range("G:G").Find(DeinWert)
If rng Is Nothing Then
Else
  first = rng.Address
    rng.EntireRow.Copy
    Worksheets("Zusammenfassung").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
End If
   
   
Set rng = Worksheets("640").Range("G:G").Find(DeinWert)
If rng Is Nothing Then
Else
  first = rng.Address
    rng.EntireRow.Copy
    Worksheets("Zusammenfassung").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
End If


Set rng = Worksheets("695").Range("G:G").Find(DeinWert)
If rng Is Nothing Then
Else
  first = rng.Address
    rng.EntireRow.Copy
    Worksheets("Zusammenfassung").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
End If

End Sub