Servus zusammen,
ich habe ein VBA-Problem und komme einfach nicht auf die Lösung. Ich habe nun 2 Tage mit chatGTP gesprochen und jede Menge Code-Vorschläge erhalten, aber die Spalte U wird in der Zieldatei einfach nicht befüllt. Ich bin kein VBA-Fachmann und tue mich schwer in der Lösungsfindung. Vielleicht kann mir jemand auf die Sprünge helfen?

Ich habe 3 Dateien in einem Ordner:
• Mappe-final.xlsm – hier ist das Makro drin
• Mappe-Test-300_Daten_Import.xlsx - hier sind die Daten drin, die zuerst reinkopiert werden (können auch importiert werden, egal)
• 01-24-24_dwpsMappe_Kopie_1_01-25-24_17-28.xlsm – von hier werden die Kommentare geholt, das ist wie eine 2. Quelldatei

Der Code erstellt am Ende stets korrekt eine Datei mit dem Namensmuster "mm/dd/yyyy_dwpMappe_Kopie_mm/dd/yyyy:hh/mm"vorne gestriges Datum, hinten heutiges inklö. Uhrzeit. Am nächsten Tag soll sich das script die Musterdatei von gestern holen und die dort eingebrachten Kommentare rauskopieren und in die Zieldatei einfügen. Wenn man das script also heute ausführt, soll es sich die Kommentare aus "01-24-24_dwpsMappe_Kopie_1_01-25-24_17-28.xlsm"holen und vorher die Daten aus "Mappe-Test-300_Daten_Import.xlsx" kopieren und in bestimmte Spalten einfüge (das funktioniert auch supermit dem script, aber die Spalte U wird nicht befüllt mit Kommentaren.

Hier ist der Code, vielleicht erbarmt sich jemand und kann mir helfen ;-)
------------------------
Sub Daten_Importieren()

' Deaktiviere Bildschirmaktualisierung
Application.ScreenUpdating = False

On Error GoTo ErrorHandler
Dim Pfad As String
Dim Daten_Datei As Workbook
Dim Ziel_Datei As Workbook
Dim Daten_WS As Worksheet
Dim Ziel_WS As Worksheet
Dim i As Integer

' Pfad zur Daten-Datei
Pfad = ThisWorkbook.Path & "\Mappe-Test-300_Daten_Import.xlsx"

' Daten-Datei öffnen
Set Daten_Datei = Workbooks.Open(Pfad)

' Daten-Worksheet auswählen
Set Daten_WS = Daten_Datei.Worksheets("Tabelle1")

' Ziel-Datei öffnen
Set Ziel_Datei = ThisWorkbook

' Ziel-Worksheet auswählen
Set Ziel_WS = Ziel_Datei.Worksheets("Formeln")

' Daten aus der letzten abgespeicherten Datei mit "dwpMappe_Kopie" importieren
ImportKommentareVonLetzterDatei Ziel_WS

' Kopiere Daten in Spalte S...
Debug.Print "Kopiere Daten in Spalte S..."

' Aktualisiere die Zielzeile für den nächsten Durchlauf
ZielZeile = 2 ' Startzeile im Ziel-Worksheet

' Kopiere die Daten von der aktuellen Zeile in der Quelldatei in die Zielzeile
Do While Not IsEmpty(Daten_WS.Range("A" & ZielZeile))
Ziel_WS.Range("A" & ZielZeile & ":B" & ZielZeile).Value = Daten_WS.Range("A" & ZielZeile & ":B" & ZielZeile).Value
Ziel_WS.Range("M" & ZielZeile & ":M" & ZielZeile).Value = Daten_WS.Range("B" & ZielZeile & ":B" & ZielZeile).Value
Ziel_WS.Range("G" & ZielZeile & ":K" & ZielZeile).Value = Daten_WS.Range("G" & ZielZeile & ":K" & ZielZeile).Value
Ziel_WS.Range("N" & ZielZeile & ":P" & ZielZeile).Value = Daten_WS.Range("N" & ZielZeile & ":P" & ZielZeile).Value

' Debug-Ausgabe für jede kopierte Zeile
Debug.Print "Daten in Spalte S der Quelldatei (Zeile " & ZielZeile & "): " & Ziel_WS.Range("S" & ZielZeile).Value

' ... (weitere Codeabschnitte)

' Aktualisiere die Zielzeile für den nächsten Durchlauf
ZielZeile = ZielZeile + 1
Loop

' ... (dein bisheriger Code bleibt hier)

' Hinzufügen der schwarzen Kontur und Ändern der Hintergrundfarbe basierend auf den Kontonummern
Dim AktuelleKontonummer As Variant
Dim FarbeWechsel As Boolean
Dim ErsteZeile As Boolean

For Zeile = 2 To Ziel_WS.Range("A" & Rows.Count).End(xlUp).Row
If Ziel_WS.Range("N" & Zeile).Value > Ziel_WS.Range("N" & Zeile - 1).Value Then
' Hinzufügen der schwarzen Kontur zur gesamten Zeile (von Spalte A bis T) am Anfang der Kontonummer
Ziel_WS.Range("A" & Zeile - 1 & ":T" & Zeile - 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
Ziel_WS.Range("A" & Zeile - 1 & ":T" & Zeile - 1).Borders(xlEdgeBottom).Color = RGB(0, 0, 0) ' Schwarz
Ziel_WS.Range("A" & Zeile - 1 & ":T" & Zeile - 1).Borders(xlEdgeBottom).Weight = xlThin

' Wechsel der Hintergrundfarbe bei einer Änderung der Kontonummer
FarbeWechsel = Not FarbeWechsel
If FarbeWechsel Then
Ziel_WS.Range("A" & Zeile & ":T" & Zeile).Interior.Color = RGB(204, 255, 204) ' Hellgrün
Else
Ziel_WS.Range("A" & Zeile & ":T" & Zeile).Interior.Color = RGB(255, 223, 191) ' 5% Orange
End If

' Aktuelle Kontonummer aktualisieren und Flag für die erste Zeile setzen
AktuelleKontonummer = Ziel_WS.Range("N" & Zeile).Value
ErsteZeile = True
Else
' Wenn die Kontonummer gleich bleibt, gleiche Farbe wie die vorherige Zeile beibehalten
Ziel_WS.Range("A" & Zeile & ":T" & Zeile).Interior.Color = Ziel_WS.Range("A" & Zeile - 1 & ":T" & Zeile - 1).Interior.Color
' Keine schwarze Kontur, wenn die Kontonummer gleich bleibt
Ziel_WS.Range("A" & Zeile & ":T" & Zeile).Borders(xlEdgeBottom).LineStyle = xlNone
' Flag für die erste Zeile zurücksetzen
ErsteZeile = False
End If
Next Zeile

' ... (weitere Codeabschnitte)

' Ziel-Datei speichern
i = 1
Do While Dir(ThisWorkbook.Path & "\" & Format(Date - 1, "mm-dd-yy") & "_dwpMappe_Kopie_" & i & "_" & Format(Date, "mm-dd-yy") & "_" & Format(Time, "hh-mm") & ".xlsm") > ""
i = i + 1
Loop
Ziel_Datei.SaveAs ThisWorkbook.Path & "\" & Format(Date - 1, "mm-dd-yy") & "_dwpMappe_Kopie_" & i & "_" & Format(Date, "mm-dd-yy") & "_" & Format(Time, "hh-mm") & ".xlsm", FileFormat:=52

' Ziel-Datei schließen ohne zu speichern
Ziel_Datei.Close SaveChanges:=False

' Daten-Datei schließen
Daten_Datei.Close SaveChanges:=False

' Warte einen Moment, um sicherzustellen, dass Excel die Änderungen verarbeitet hat
Application.Wait (Now + TimeValue("0:00:02")) ' Hier wartest du 2 Sekunden, du kannst dies anpassen

' Aktiviere Bildschirmaktualisierung
Application.ScreenUpdating = True
Exit Sub

ErrorHandler:
' Aktiviere Bildschirmaktualisierung im Fehlerfall
Application.ScreenUpdating = True
MsgBox "Ein Fehler ist aufgetreten: " & Err.Description
End Sub

'' Funktion zum Importieren von Kommentaren aus der zuletzt abgespeicherten Datei mit "dwpMappe_Kopie"
Private Sub ImportKommentareVonLetzterDatei(ByRef Ziel_WS As Worksheet)
Dim Letzte_Datei As String
Dim Gestrige_Datei As Workbook
Dim Letztes_WS As Worksheet
Dim Kommentar As String
Dim Zeile As Long

' Name der letzten abgespeicherten Datei mit "dwpMappe_Kopie" ermitteln
Letzte_Datei = GetLastSavedDwpMappeKopieFileName(ThisWorkbook.Path)

If Letzte_Datei > "" Then
' Debug-Ausgabe
Debug.Print "Letzte abgespeicherte 'dwpMappe_Kopie' Datei: " & Letzte_Datei

' Letzte abgespeicherte Datei öffnen
On Error Resume Next
Set Gestrige_Datei = Workbooks.Open(Letzte_Datei)
On Error GoTo 0

If Not Gestrige_Datei Is Nothing Then
' Debug-Ausgabe
Debug.Print "Letzte abgespeicherte 'dwpMappe_Kopie' Datei geöffnet: " & Gestrige_Datei.Name

' ... (weitere Debug-Ausgaben)

' Letztes Worksheet auswählen
Set Letztes_WS = Gestrige_Datei.Worksheets("Formeln")

' Import von Kommentaren
For Zeile = 2 To Ziel_WS.Range("A" & Rows.Count).End(xlUp).Row
' Kopiere den Wert aus Spalte S
Ziel_WS.Range("S" & Zeile).Value = Letztes_WS.Range("S" & Zeile).Value

' Kopiere den Kommentar
Kommentar = Letztes_WS.Range("S" & Zeile).Comment.Text
Debug.Print "Inhalt von Spalte S in der letzten 'dwpMappe_Kopie' Datei (Zeile " & Zeile & "): " & Kommentar
If Kommentar > "" Then
Ziel_WS.Range("S" & Zeile).ClearComments
Ziel_WS.Range("S" & Zeile).AddComment Kommentar
Ziel_WS.Hyperlinks.Add Ziel_WS.Range("S" & Zeile), "", "", Kommentar
Debug.Print "Kommentar importiert in Zeile " & Zeile & ": " & Kommentar
Debug.Print "Quelle der Kommentare: " & Letzte_Datei
Else
Debug.Print "Kein Kommentar gefunden in Zeile " & Zeile
End If
Next Zeile

' ... (weitere Debug-Ausgaben)

' Letzte abgespeicherte Datei schließen
Gestrige_Datei.Close SaveChanges:=False
End If
End If
End Sub


' Funktion zum Ermitteln des Namens der letzten abgespeicherten Datei mit "dwpMappe_Kopie"
Function GetLastSavedDwpMappeKopieFileName(folderPath As String) As String
Dim fileName As String
Dim lastSaved As Date
Dim currentFile As String

fileName = Dir(folderPath & "\*___dwpMappe_Kopie___*.xlsm")
Do While fileName > ""
' Überprüfen, ob der Dateiname dem erwarteten Format entspricht
If InStr(1, fileName, "_dwpMappe_Kopie_", vbTextCompare) > 0 Then
currentFile = folderPath & "\" & fileName
If FileDateTime(currentFile) > lastSaved Then
lastSaved = FileDateTime(currentFile)
GetLastSavedDwpMappeKopieFileName = currentFile
End If
End If
fileName = Dir
Loop
End Function
-------------------