Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1244to1248
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro zum Kopieren/Löschen von Zeilen und Einfügen

Makro zum Kopieren/Löschen von Zeilen und Einfügen
Zeilen
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

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro zum Kopieren/Löschen von Zeilen und Einfügen
06.01.2012 08:56:49
Zeilen
Ich würde auf einer zweiten Seite mit SVERWEIS- oder WENN- Funktion die Daten hereausfiltern und diese Seite in Dein Archiv kopieren.
AW: Versuch mal das!
06.01.2012 09:41:31
Thomas
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
Anzeige
AW: Versuch mal das!
06.01.2012 10:59:05
TUE
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
AW: Versuch mal das!
06.01.2012 11:35:56
Thomas
Hallo Tobias,
da bin ich überfragt seh deine Tabelle nicht.
Gruß Thomas
AW: Versuch mal das!
09.01.2012 08:43:57
TUE
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
Anzeige
AW: Versuch mal das!
09.01.2012 09:08:42
hary
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
AW: ergaenzung
09.01.2012 09:40:26
hary
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
Anzeige
AW: ergaenzung
09.01.2012 13:03:49
TUE
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
AW: ergaenzung
09.01.2012 13:20:51
hary
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

Anzeige

379 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige