Microsoft Excel

Herbers Excel/VBA-Archiv

Makro zum Kopieren/Löschen von Zeilen und Einfügen | Herbers Excel-Forum


Betrifft: Makro zum Kopieren/Löschen von Zeilen und Einfügen von: TUE
Geschrieben am: 06.01.2012 08:19:19

Guten Morgen,

ich versuche gerade eine Funktion zu realisieren, die Zeilen aus Tabellenblatt A
dann in das Tabellenblatt ARCHIV verschiebt, wenn in der Spalte J ein x gesetzt
wird.

Folgende Probleme/Fragen habe ich in diesem Zusammenhang:

1. Wie kann ich es realisieren, dass das Makro dann ausgeführt wird, wenn ein x in Spalte J ist?
2. Wie sage ich dem Makro oder VBA, dass es dann nur die Zeile mit dem x sofort löschen/verschieben soll?
3. Was muss ich tun, damit die in Zeile aus Tabellenblatt A in die jeweils aktuell letzte freie Zeile im
ARCHIV - Blatt kopiert wird?

Ich hoffe, dass mir jemand helfen kann und freue mich auf Eure Lösungsvorschläge.

Vielen Dank!

LG
Tobias

https://www.herber.de/bbs/user/78245.xlsm

  

Betrifft: AW: Makro zum Kopieren/Löschen von Zeilen und Einfügen von: André Zschech
Geschrieben am: 06.01.2012 08:56:49

Ich würde auf einer zweiten Seite mit SVERWEIS- oder WENN- Funktion die Daten hereausfiltern und diese Seite in Dein Archiv kopieren.


  

Betrifft: AW: Versuch mal das! von: Thomas
Geschrieben am: 06.01.2012 09:41:31

Guten Morgen Tobias,

den Code in die Tabelle A einfügen.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   Dim rngC As Range, rngA As Range

   For Each rngC In Range("J2", Cells(Rows.Count, 10).End(xlUp))
      If rngC.Row > 1 And UCase(rngC.Value) = "X" Then
         If rngA Is Nothing Then Set rngA = rngC Else Set rngA = Union(rngA, rngC)
      End If
   Next rngC

   If Not rngA Is Nothing Then
      With Worksheets("Archiv")            ' Zieltabelle
         rngA.EntireRow.Copy .Cells(.Rows.Count, 10).End(xlUp).Offset(1, -9)
         rngA.EntireRow.Delete
      End With
   End If
End Sub

Der Code Kopiert ab der 2 Zeile da du bestimmt die erste Zeile beschriftet hast.

Gruß Thomas


  

Betrifft: AW: Versuch mal das! von: TUE
Geschrieben am: 06.01.2012 10:59:05

Hallo Thomas,

in meiner Testumgebung klappt es prima, auch wenn ich die Zeilen nach unten verschiebe.

Ich haben den Code in einer komplexeren Tabelle eingefügt die mehr Spalten, etc. hat.
Dort erhalte ich beim Setzten des X folgende Fehlermeldung:

Laufzeitfehler 13: Typen unverträglich und im Code wird folgende Zeile markiert:

If rngC.Row > 1 And UCase(rngC.Value) = "X" Then"

Woran könnte das liegen?

Vielen Dank!

MfG
Tobias


  

Betrifft: AW: Versuch mal das! von: Thomas
Geschrieben am: 06.01.2012 11:35:56

Hallo Tobias,

da bin ich überfragt seh deine Tabelle nicht.

Gruß Thomas


  

Betrifft: AW: Versuch mal das! von: TUE
Geschrieben am: 09.01.2012 08:43:57

Guten Morgen,

hier habe ich die umfangreichere Tabelle hochgeladen und hoffe,
dass Ihr mir Tipps geben könnt.

https://www.herber.de/bbs/user/78316.xlsm

Vielen Dank!

LG
TUE


  

Betrifft: AW: Versuch mal das! von: hary
Geschrieben am: 09.01.2012 09:08:42

Moin
Der Fehler kommt daher: Das loeschen startet das Change-Ereigniss neu.

     Application.EnableEvents = False 'damit schaltetst Du das erneute starten aus
           'hier dein Code
     Application.EnableEvents = true 'muss wieder eingeschaltet werden.

Schreibfehler hinter copy da steht I
gruss hary


  

Betrifft: AW: ergaenzung von: hary
Geschrieben am: 09.01.2012 09:40:26

Hallo nochmal
eigentlich brauchst Du doch keine Schleife. Hiermit wird bei wechsel auf x der Code ausgefuehrt.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
  If Target.Row > 3 And Target.Column = 23 Then
      With Worksheets("ARCHIV")            ' Zieltabelle
         Rows(Target.Row).Copy .Cells(.Rows.Count, 10).End(xlUp).Offset(1, -9)
         Rows(Target.Row).Delete
      End With
   End If
End Sub

gruss hary


  

Betrifft: AW: ergaenzung von: TUE
Geschrieben am: 09.01.2012 13:03:49

Hey,

danke hary! Klappt jetzt wirklich super.

Allerdings erhalte ich folgende Meldung, wenn ich mein "x" gesetzt habe.

https://www.herber.de/bbs/user/78319.jpg

Die kommt leider jedes Mal.

Wie kann ich das umgehen/abstellen?

Vielen Dank!

LG
TUE


  

Betrifft: AW: ergaenzung von: hary
Geschrieben am: 09.01.2012 13:20:51

Hallo
mit Meldung ausschalten. Versuch mal so. Nicht getestet.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
  If Target.Row > 3 And Target.Column = 23 Then
      With Worksheets("ARCHIV")
      Application.DisplayAlerts = False 'Warnung ausschalten
         Rows(Target.Row).Copy .Cells(.Rows.Count, 10).End(xlUp).Offset(1, -9)
         Rows(Target.Row).Delete
         Application.DisplayAlerts = True 'Warnung einschalten
      End With
   End If
End Sub
gruss hary



Beiträge aus den Excel-Beispielen zum Thema "Makro zum Kopieren/Löschen von Zeilen und Einfügen"