Ich bastle wieder mal seit einiger Zeit an einem Problemchen und komme wiedermal nicht von selbst drauf! Chat GPT ist zu doof, also müssen wider mal die echten Stars ran!
Kurz die Funktion des Moduls: ( Code folgt:)
Über das Jahr sammle ich mit einer Userform daten, welche ende Jahr in ein Archiv überführen will. Dies mit einem Steuerelement direkt auf der " Arbeitstabelle" über ein Modul ( Nicht Userform). Dabei sollte eine dynamische Range der Tabelle 1 ( Arbeitstabelle) kopiert werden, die Arbeitsmappe (Archiv sterjahr) geöffnet und genz Hinten eine neue Tabelle eingefügt werden, und anschliessend die Range der Tabelle1 ( Arbeitstabelle) in das neue Tabellenbaltt der Arbeitsmappe Archiv Steuerjahr einkopiert werden.
Da eiere ich nun etwas rum.
Der teil der anschliessend die Arbeitstabelle zurücksetzt (Löschen Zeilen hochschieben) und sie für das neue Jahr fit macht funktioniert.
Hier nun der Code:
Option Explicit
Const conArchivSteuerjahr = ("C:\Users\Chatzebuseli\Documents\Archiv steuerrelevante Quittungen\Archiv Steuerjahr.xlsx")
Public Sub NeuesSteuerjahr()
Dim intZ As Integer
Dim strJahr As String
Dim wb1, wb2 As Worksheet
Set wb1 = Sheets("Arbeitstabelle") 'Setzt Workseed als Objekt
Set wb2 = Sheets("Druckvorlage")
Application.ScreenUpdating = False
strJahr = Tabelle1.Cells(2, 6).Value
Set wbArchivSteuerjahr = Workbooks.Open(conArchivSteuerjahr) ' öffnen des Archives geht!
With wbArchivSteuerjahr ' Einfügen der neuen Tabelle und Umbenenen geht auch !
.Worksheets.Add.Name = strJahr
ActiveSheet.Move After:=Sheets(Sheets.Count) 'An hinterste Stelle setzen ok!
End With
intZ = wb1.Cells(Rows.Count, 1).End(xlUp).Row 'Und hier beginnt es wie um himmels willen lautet hier die Syntax um diese Definierte Range nun vom Workbook
wb1.Range("A5:H" & intZ).Select '(Eingabe.xlsx)Tabelle 1 in das Workbook (Archiv Steuerjahr) hinüber zu kopieren?
Selection.Copy 'Ist die Reihenfolge mit den SET ein Problem? Sind die Objekte Falsch definiert? Haut das so mit Select nicht hin oder wo liegt hier der Hund begraben?
With wbArchivSteuerjahr
.Sheets(strJahr).Range("A5").PasteSpecial xlPasteAll ' Irgend ein überbleibsel des Gebstels und Reste des 157 Versuches!
End With
Set wbArchivSteuerjahr = Nothing
'''''''''''''''''''' Ab hier ist der Code schon etwas älter und läuft wieder ''''''''''''''''''''''''''''''''
intZ = wb1.Cells(Rows.Count, 1).End(xlUp).Row 'Range definition dynamisch
wb1.Range("A5:H" & intZ).Select
Selection.Delete Shift:=xlUp
wb2.Activate
intZ = wb2.Cells(Rows.Count, 4).End(xlUp).Row
wb2.Range("A8:G" & intZ).Select
Selection.Delete Shift:=xlUp
intZ = Tabelle1.Cells(2, 6).Value
intZ = intZ + 1
Tabelle1.Cells(2, 6).Value = intZ
Tabelle2.Cells(1, 6).Value = intZ
wb1.Activate
Application.ScreenUpdating = True
End Sub
Wer kann mir hier den Knoten etwas lockern? Danke für eure Mühe..... und hey Chat GPT war zu doof! Ihr seit besser! ;-)
E liebs Griessli
Chatzebuseli