Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Übernahme von Daten

Betrifft: Übernahme von Daten von: Gero Becker
Geschrieben am: 06.10.2020 12:11:02

Hallo Zusammen und schon mal vorab vielen Dank für Eure Hilfe.

Ich habe mit folgender Tabelle ein Problem. https://www.herber.de/bbs/user/140693.xlsm

Ich würde gerne von Registerblatt Übergabe alle Zeilen in das Register Archiv übernehmen wenn Sie älter als 14 Tage sind. Soweit so gut. Die Zeilen werden auch übernommen und gelöscht aber die Zuordnung gerät oft einfach durcheinander.

So steht dann in der Übergabe der Text aus Spalte E Zeile 7 nicht mehr bei 7 sondern bei 6.
Also einfach eine falsche zu ordnung.

Sub Copy_to_Archiv()
  Dim wksQ As Worksheet, zeiQ As Long, zeiQL As Long, zeiQT As Long
  Dim wksZ As Worksheet, zeiZ As Long
  Dim StatusAutofilter As Boolean
  
  Set wksQ = ActiveWorkbook.Worksheets("Übergabe")
  Set wksZ = ActiveWorkbook.Worksheets("Archiv")
  zeiQT = 1 'Zeile mit den Spaltentiteln im Blatt Übergabe
  With wksZ
    zeiZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
  End With
  With wksQ
    StatusAutofilter = .AutoFilterMode
    If .AutoFilterMode = True Then
      If .FilterMode = True Then .ShowAllData
      zeiQ = .Cells(.Rows.Count, 1).End(xlUp).Row
    Else
      zeiQ = .Cells(.Rows.Count, 1).End(xlUp).Row
      .Range(.Rows(zeiQT), .Rows(zeiQ)).AutoFilter
    End If
    'Autofilter setzen
    'Spalte C (erledigt) = a
    .AutoFilter.Range.AutoFilter field:=3, Criteria1:="=a"
    'Spalte B (Festgestellt am) <= Heute - 14
    .AutoFilter.Range.AutoFilter field:=2, Criteria1:="<=" & CDbl(Date - 14)
    zeiQL = .Cells(.Rows.Count, 1).End(xlUp).Row
    If zeiQL = zeiQT Then
      MsgBox "Keine erledigten Einträge älter als 14 Tage"
    Else
      .Range(.Rows(zeiQT + 1), .Rows(zeiQL)).Copy Destination:=wksZ.Cells(zeiZ, 1)
      'in Spalte C der kopierten Zeilen WAHR eintragen, um archivierte Zeilen zu markieren
      .Range(.Cells(zeiQT + 1, 3), .Cells(zeiQL, 3)).Value = True
      .ShowAllData
      'Archivierte  Zeilen löschen
      .Range(.Cells(zeiQT + 1, 3), .Cells(zeiQ, 3)).SpecialCells(xlCellTypeConstants, _
         xlLogical).EntireRow.Delete
      
    End If
    If StatusAutofilter = False Then
      .AutoFilterMode = False
    End If
  End With
End Sub

Betrifft: AW: Übernahme von Daten
von: onur
Geschrieben am: 06.10.2020 17:28:30

Kein Wunder - Du sortierst den Bereich A2:C45 und lässt D bis E aussen vor.