Bitte nicht zu kritisch ;-) beäugen, ist mein erstes Projekt.

Ok. :)

Option Explicit

Private Sub CommandButton1_Click()
'****Neuer Datensatz anlegen und neue freie Nummer erzeugen*****
   Dim lZeile As Long
   
 '*** Worksheets("Tabelle1").Activate   '*************Hier aktiviere ich die Tabelle 1 weil ich mit
                                    ' Call ÄAnummer die nächste freie Nummer erzeuge. Das kann aber nur in Tabelle1 stattfinden
                                    ' sieht man dann weiter unten unter ÄAnummer
                                    ' Wenn ich aus dem Formular heraus die Datenbank aufrufe, um den Eintrag zu machen und die nächste
                                    'freie Nummer zu bekommen bleibt Execl hier hängen und sagt Laufzeit Fehler 1.
                                    'Aber immer nur wenn die 2. Mappe auch offen ist
                                    '**********************************************************************************************
                                    
     'neuen Eintrag erstellen,Eintrag in der ListBox und markieren Benutzer kann Daten eintragen
      'Start in Zeile 2, Zeile 1 sind ja die überschriftrn
     'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
     lZeile = 2
     Do While LTrim(CStr(Tabelle1.Cells(lZeile, 1).Value)) > ""
         lZeile = lZeile + 1 'Nächste Zeile bearbeiten
     Loop
     
     'Nach Durchlauf dieser Schleife steht lZeile in der ersten leeren Zeile von Tabelle1
     'Neuen Eintrag in die Tabelle1 schreiben, Spalte ID muss gefüllt sein, damit
     'unsere Routinen die Zeile wiederfinden!
         Tabelle1.Cells(lZeile, 1) = CStr(lZeile) - 1 '"Neuer Eintrag Zeile "& lZeile

    '***
     Call ÄAnummer(ThisWorkbook.Worksheets("Tabelle1"))

          'Und neuen Eintrag in die UserForm eintragen
   ListBox1.AddItem CStr(lZeile) - 1 '"Neuer Eintrag Zeile " & lZeile
          'Den neuen Eintrag markieren mit Hilfe des ListIndexes
     ListBox1.ListIndex = ListBox1.ListCount - 1
     'Durch das Click Ereignis der ListBox werden die Daten automatisch geladen
          'CheckBoxen 3 - 5 für neuen Eintrag freigeben
        CheckBox5.Enabled = True
        CheckBox3.Enabled = True
        CheckBox4.Enabled = True
                'Textboxen 11,13,15 freigeben für neuen Eintrag
          TextBox11.Enabled = True
          TextBox13.Enabled = True
          TextBox15.Enabled = True
             'Marke offene Anträge setzen
       If TextBox11.Text = "" Then
           TextBox15.Text = "-"
            ElseIf TextBox11.Value = True Then
            TextBox15.Text = ""
       End If
End Sub

 

'***********************************************************************************************
'***********************************************************************************************
'Nächste frei Nummer des ÄA ermitteln **********************************************************
'***********************************************************************************************
Sub ÄAnummer(ByRef wks As Excel.Range)
    Dim ÄANr As Long
    Dim Jahr As Integer
    Dim intLZ As Long
    Dim intCol As Integer
    Dim NextZ
    Dim NextÄANr


    With wks
        
        Jahr = .Cells(2, 31)
        ÄANr = .Cells(2, 32)
        
        If Jahr <> Year(Date) Then
            ÄANr = 0
            Jahr = Year(Date)
            .Cells(2, 31) = Jahr
            
        End If
        
        ÄANr = ÄANr + 1                                     ' Hier wird die laufende Nummer nach der Jahreszahl des ÄA hochgezählt
        .Cells(2, 32) = ÄANr
        
        NextÄANr = "ÄA_" & Jahr & "_" & ÄANr
        'Cells(1, 1) = NextÄANr
        
        
        intCol = 4                                           'Nummer ist Spalte in der gesucht wird diese ist in Tabelle1
        
        NextZ = .Cells(Rows.Count, intCol).End(xlUp).Row
        
        .Range("D" & NextZ + 1).Value = NextÄANr
        
        NextZ = NextZ + 1
    End With
    
End Sub