Hallo,

Leider habe ich ein Problem wo ich derzeit nicht weiter weis.

Ich habe einen Sub mit welchem ich aus Word-VBA in Excel-Tabelle schreiben kann. Dies funktionniert aus so weit.

Es gibt zwei Möglichkeiten, die eine besteht darin einen Wert zu finden und diese Zeile mit neuen Werten zu überschreiben und die zweite besteht darin die letzte gefüllte Zeile zu Finden in Spalte A zu finden und eine Zeile drunter zu schreiben. Dies funktionniert auch alles jedoch habe ich ein Problem bei der zweiten Funktion, dass sich das Excel nicht komplett schließt welches beschrieben wurde obwohl dies bei der Funktion überschreiben kein Problem ist.

Villeicht kennt einer eine Lösung:

Sub ExcelSchreiben()

Dim xlApp As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlws As Excel.Worksheet
Dim Zeile As Long
Dim RefOld As String
Dim RefNew As String
Dim Nummer As String
Dim Mail As String
Dim Modus As Integer
Dim SelectForm As Integer
Dim RefJahr As String
Dim rng As Excel.Range

RefOld = ""
RefNew = ""
RefJahr = "-22"

SelectForm = 3

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

Set xlwb = xlApp.Workbooks.Open("C:\Users\Fre825\Desktop\New folder (5)\Mappetest.xlsx")
Set xlws = xlwb.Worksheets("Tabelle1")

If SelectForm = 3 Then
    
   
   Set rng = xlws.Columns(1)
    
   With rng
   Zeile = .Cells(Rows.Count, 1).End(xlUp).Row
   End With
    
    RefOld = xlws.Cells(Zeile, 1).Value
    If RefOld <> "" Then
    RefNew = CStr(CInt(Left(RefOld, 3)) + 1) & RefJahr
    End If
    
    Modus = 1

Else

If SelectForm = 2 Then
    
    Set rng = xlws.Range("A:A").Find("502")
    
    Zeile = CStr(rng.Row)
    
    Modus = 0

End If
End If

xlwb.Save
xlwb.Close
xlApp.Quit

Set xlws = Nothing
Set xlwb = Nothing
Set xlApp = Nothing

End Sub