Ich habe ein Problem mit meinem VBA Programm.
Grundlage: Ein Tabellenblatt mit all meine Musikstücken, Noten Beispiele etc. zusammengefasst in einer Intelligenten Tabelle mit 7 Spalten. Die Siebte Spalte hat ein Datumsformat. Insgesamt sind in dem Tabellenblatt "Alle" z.Z. 370 Einträge.
Das Ziel ist es Änderungen zu erkennen und in dem Zieldatenblatt sortiert einzufügen.
Ein Zieldatenblatt ist hier als Beispiel Weihnacht. Dieses Tabellenblatt habe ich vom Tabellenblatt "Alle" kopiert(wegen der Kopfzeile), umbenannt und alle Zeilen außer der Überschrift gelöscht.
Das Ziel Datenblatt wird durch eine Schaltfläche im Tabellenblatt Startseite geöffnet.
Sobald ich das Makro ausführe (ohne Fehlermeldung) wird die ganze Tabelle "Alle" am Tabellenanfang eingefügt und ausgeblendet und nochmals das komplette Tabellenblatt "Alle" eingefügt.(?????) Eine Sortierung hat nicht stattgefunden.
Jetzt habe ich 390 ausgeblendete Zeilen samt zweiter Kopfzeile. Bei hinzufügen eines neuen Weihnacht Titel , erneuten Aufruf der Zieldatenbank ist eine neue Zeile vor der Tabelle eingefügt. Jetzt also 391 ausgeblendete und 370 neue.
Ich finde zur Zeit keinen Fehler. ich bitte um Ratschläge und Vorschläge woher der Fehler kommt, von mir mal abgesehen, und wie ich das gesteckte Ziel erreichen kann.
Hier das Makro:
Sub Nav_Weihnacht()
Call Sheetswitch("Weihnacht")
Dim wsUebersicht As Worksheet
Dim wsGenre As Worksheet
Dim lastRow As Long
Set wsUebersicht = ThisWorkbook.Sheets("Alle")
Set wsGenre = ThisWorkbook.Sheets("Weihnacht")
lastRow = wsUebersicht.Cells(wsUebersicht.Rows.Count, 2).End(xlUp).Row
wsUebersicht.UsedRange.Copy wsGenre.Cells(lastRow + 1, 2)
wsGenre.AutoFilterMode = False
wsGenre.Range("D10").AutoFilter Field:=4, Criteria1:="Weihnacht"
Dim ws As Worksheet
Dim visibleRows As Long
Dim i As Long
' Aktives Tabellenblatt
Set ws = ActiveSheet
' Letzte Zeile mit Inhalt ermitteln
lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
' Zählen der sichtbaren Zeilen mit Inhalt
For i = 2 To lastRow
If Not ws.Rows(i).Hidden Then
If Application.WorksheetFunction.CountA(ws.Rows(i)) > 0 Then
visibleRows = visibleRows + 1
End If
End If
Next i
'Application.CutCopyMode = False
Dim oData As New DataObject ' Objekt für die Zwischenablage
oData.SetText Text:=Empty ' Leeren
oData.PutInClipboard ' In die Zwischenablage einfügen, um sie zu leeren
Range("G5") = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count + 1
ActiveWindow.DisplayVerticalScrollBar = True
End Sub