Kopieren von Zeilen aus einer Tabelle in eine andere per Macro

Dieses Thema Kopieren von Zeilen aus einer Tabelle in eine andere per Macro im Forum "Microsoft Office Suite" wurde erstellt von Ginkgo, 26. Apr. 2005.

Thema: Kopieren von Zeilen aus einer Tabelle in eine andere per Macro Hallo Zusammen, ich habe mal wieder ein Problem das zu hoch für mich ist. Ich habe in Zeile, sagen wir 3, eine...

  1. Hallo Zusammen,

    ich habe mal wieder ein Problem das zu hoch für mich ist.
    Ich habe in Zeile, sagen wir 3, eine Statusnummer stehen und in Zeile 10 ein Datum. Dieses Datum trägt sich automatisch ein wenn status 10 erreicht ist. Nun möchte ich, wenn der status 10 oder höher ist und das datum älter als 30 Tage ist, dass sich diese Zeilen ausschneiden und in dem selben workbook in die Tabelle Archiv verschoben werden. Geht das per Makro oder habe ich eine Grenze gefunden?

    Danke für die Hilfe...
     
  2. Hi Ginkgo,

    geht :)

    Wann soll den kopiert werden ? Beim Öffnen oder beim Schließen ?

    Gruß Matjes :)
     
  3. Hi ginkgo,

    folgendes Makro übernimmt die Untersuchung deines Arbeitsblattes und verschiebt die Zeilen ans Ende des Archivblattes, wenn der Status >= 10 und das Datum älter 30 Tage ist.

    Passe bitte den Namen deines Arbeitsblattes in den Konstanten an.
    Ebenso die Konstante für die erste zu untersuchende Zeile ( c_Z_ErsteWerteZeile ).

    Das ganze Makro plazierst Du bitte in einem Modul.
    Code:
    Sub ArchivierungAlteZeilen()
     ->ggf. Anpassen
      Const c_Z_ErsteWerteZeile = 2-> erste Zeile mit Statuseintrag
      Const c_Blattname_Arbeitsblatt = Tabelle1
      Const c_Blattname_Archiv = Archiv
      
      Const c_SP_Status = 3       'Spaltennummer Status
      Const c_SP_Datum = 10       'Spaltennummer Datum
      Const c_Status_Grenze = 10 ->Status >= 10 prüfen
      Const c_Datum_minAlter = 30->30 Tage
    
      Dim wb As Workbook, b_changed As Boolean
      Dim wsq As Worksheet, l_qZeileMax As Long, q As Long
      Dim wsz As Worksheet, l_zZeileMax As Long
      Dim d_date_heute As Date, d_date As Date
      
      b_changed = False
      Set wb = ActiveWorkbook
      
      On Error Resume Next->bei Fehler mit nächster Zeile fortfahren
      
     ->Quell-Blatt
      Set wsq = Worksheets(c_Blattname_Arbeitsblatt)
      If Err.Number <> 0 Then
        Err.Clear
        MsgBox (Blatt-> & c_Blattname_Arbeitsblatt &-> konnte nicht geöffnet werden.)
        GoTo Aufraeumen
      End If
     ->Anzahl benutzter Zeilen feststellen
      l_qZeileMax = wsq.Cells(wsq.Rows.Count, c_SP_Status).End(xlUp).Row
      
     ->Ziel-Blatt
      Set wsz = Worksheets(c_Blattname_Archiv)
      If Err.Number <> 0 Then
        Err.Clear
        MsgBox (Blatt-> & c_Blattname_Archiv &-> konnte nicht geöffnet werden.)
        GoTo Aufraeumen
      End If
     ->Anzahl benutzter Zeilen feststellen
      l_zZeileMax = wsz.Cells(wsz.Rows.Count, c_SP_Status).End(xlUp).Row
      
      On Error GoTo 0->Fehlerbehandlung abschalten
      
      d_date_heute = Now()
      
     ->Alle relevanten Zeile des Quellblattes finden
      q = c_Z_ErsteWerteZeile - 1
      Do While q < l_qZeileMax
        q = q + 1
       ->Statusgrenze erreicht ?
        If wsq.Cells(q, c_SP_Status).Value >= c_Status_Grenze Then
         ->Datum nicht leer ?
          If wsq.Cells(q, c_SP_Status).Value <>  Then
            d_date = wsq.Cells(q, c_SP_Datum).Value
           ->Datum älter als 30 Tage ?
            d_date = d_date + c_Datum_minAlter
            If d_date < d_date_heute Then
             ->Zeile ausschneiden und im Archi anfügen
              l_zZeileMax = l_zZeileMax + 1
              If l_zZeileMax > 65534 Then
                MsgBox (Das Blatt  & c_Blattname_Archiv &  ist voll!)
                GoTo Aufraeumen
              End If
              wsq.Rows(q).Copy Destination:=wsz.Rows(l_zZeileMax)
              wsq.Rows(q).Delete
              q = q - 1: l_qZeileMax = l_qZeileMax - 1
              b_changed = True
            End If
          End If
        End If
      Loop
      
    Aufraeumen:
     ->Mappe speichern, wenn etwas ins Archiv verschoben wurde
      If b_changed Then
        wb.Save
      End If
      
      Set wb = Nothing: Set wsq = Nothing: Set wsz = Nothing
    End Sub
    
    Dann kannst Du das Makro ausprobieren, indem du es von Hand startest.

    Um das Ganze jetzt auch noch automatisch beim Schließen der Mappe ablaufen zu lassen, fügst Du folgendes Makro in die Code-Seite der Arbeitsmappe (DieseArbeitsmappe).
    Code:
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
      Call ArchivierungAlteZeilen
    End Sub
    Gruß Matjes :)
     
  4. ich habe es zwar schon gewusst, aber Du bestätigstes es immer wieder... Du bist ein Genie!!
    Es funktioniert, es gibt zwar noch kleinere Probleme aber ich versuche mal mit dem was ich hier gelernt habe diese selbst zu lösen. Wenn es nicht klappt dann bin ich schneller wieder hier als ich Excel sagen kann.
     
Die Seite wird geladen...

Kopieren von Zeilen aus einer Tabelle in eine andere per Macro - Ähnliche Themen

Forum Datum
Word 2010 Kopzeilen verschwinden beim kopieren & einfügen Windows XP Forum 29. Sep. 2010
EXCEL 2003 / Kopf-/ Fußzeilen kopieren Microsoft Office Suite 5. Juli 2009
Text mit Zeilenumbruch in eine Excel 2003 Zeile kopieren Microsoft Office Suite 26. Juli 2006
Bilder von Karte automatisch ins Netzwerk kopieren. Womit? Software: Empfehlungen, Gesuche & Problemlösungen 2. Okt. 2016
Befehl zum Kopieren von LInks Windows 10 Forum 19. Feb. 2016