Daten aus einem Tabellenblatt in ein anderes Tabel

Hallo Excel-Experten,
ich habe ein Problem und würde euch gerne um Hilfe bitten. Ich habe schon einen Großteil der VBAs im Archiv durchgesehen, ich komme aber nicht so richtig weiter.
Ich habe eine Arbeitsmappe mit mehreren Tabellenblättern unter anderem gibt es die Tabellen "Anfrage" und "Aufträge".
Wenn ein Kunde nun einen Auftrag anfragt, dann werden verschiedene Daten in der Tabelle "Anfrage" erfasst, erteilt der Kunde den Auftrag, dann wird in der Spalte "Freigabe" ein "x" eingetragen.
Danach werden die erfassten Daten des freigegebenen Auftrages in das Tabellenblatt "Aufträge" kopiert, durch unterschiedliche Bediener entstehen dabei jedoch immer wieder Fehler.
Ich suche nun nach einer VBA-Lösung, bei der auf anklicken einer Zelle z.B. A1 die Tabelle "Anfrage" von oben nach unten durchlaufen wird und alle Datensätze, bei denen in der Spalte "Freigabe" ein "x" steht in das Tabellenblatt "Aufträge" übertragen wird. Alle übertragenen Daten müssen in der Tabelle "Anfrage" gelöscht werden, um eine Doppelübertragung zu vermeiden, danach muss die Tabelle "Anfrage" neu durchsortiert werden, damit keine Leerzeilen mehr vorhanden sind.
Da die Tabelle "Aufträge" ja bereits Daten enthält, müssen die anzuhängenden Datensätze am Ende der Datei angehängt werden.
Ich bekomme das mit dem Macrorekorder nicht hin, habe aber auch nur ein VBA gefunden, mit dem die Daten zwar übertragen werden können, sich jedoch nicht selektieren lassen, sodass nur diejenigen Sätze übertragen werden, die das Kennzeichen "Freigabe" = "x" tragen.
Hat jemand eine Idee, wie man das mit einem VBA hinbekommt?
LG Matthias

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Freigegebene_uebertragen() Dim wksAnfrage As Worksheet, wksAuftrag As Worksheet Dim Zeile_1 As Long, Zeile_2 As Long Const Spalte_X As Long = 4 'Spalte mit den x-Einträgen im Blatt "Anfrage" Const ZeileTitel As Long = 1 'Zeile mit den Spaltentiteln im Blatt "Anfrage" Set wksAnfrage = Worksheets("Anfrage") Set wksAuftrag = Worksheets("Aufträge") With wksAuftrag 'Letzte Datenzeile im Blatt "Aufträge", als Spalte (hier 1) eine Spalte wählen, _ in der in jeder Zeile ein Wert eingetragen wird - z.B. Kundenname oder Kunden-Nr. Zeile_2 = .Cells(.Rows.Count, 1).End(xlUp).Row End With Application.ScreenUpdating = False With wksAnfrage 'Spalten mit Eintrag "x" unter Freigabe kopieren nach Blatt "Aufträge" For Zeile_1 = ZeileTitel + 1 To .Cells(.Rows.Count, Spalte_X).End(xlUp).Row If LCase(.Cells(Zeile_1, Spalte_X).Value) = "x" Then Zeile_2 = Zeile_2 + 1 .Rows(Zeile_1).Copy wksAuftrag.Cells(Zeile_2, 1).PasteSpecial Paste:=xlPasteValues wksAuftrag.Cells(Zeile_2, Spalte_X) = Date 'X-Eintrag durch aktuelles Datum ersetzen End If Next Application.CutCopyMode = False 'Zeilen mit "x" von unten nach oben löschen For Zeile_1 = .Cells(.Rows.Count, Spalte_X).End(xlUp).Row To ZeileTitel + 1 Step -1 If LCase(.Cells(Zeile_1, Spalte_X).Value) = "x" Then .Rows(Zeile_1).Delete End If Next End With Application.ScreenUpdating = True MsgBox "Fertig", vbInformation + vbOKOnly, "Aufträge kopieren/löschen" End Sub

Hallo Franz,
vielen Dank für das Skript, ich habe es angepasst und es klappt ganz hervorragend, vielen Dank dafür!
Der Code für das Tabellenblatt lautet nun:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Address = "$A$3" Or Target.Address = "$B$3" Or Target.Address = "$C$3" Or Target. _
Address = "$D$3" Or Target.Address = "$E$3" Or Target.Address = "$F$3" Or Target.Address = "$G$3" Or Target.Address = "$H$3" Or Target.Address = "$I$3" Or Target.Address = "$J$3" Or Target.Address = "$K$3" Or Target.Address = "$L$3" Or Target.Address = "$M$3" Or Target.Address = "$P$3" Or Target.Address = "$S$3" Then
Range("A5:AE204").Sort Key1:=Target.Offset(2), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub

Sub Freigabe_Übertragen()
Dim wksAnfrage As Worksheet, wksAuftrag As Worksheet
Dim Zeile_1 As Long, Zeile_2 As Long
Const Spalte_X As Long = 1 'Spalte mit den x-Einträgen im Blatt "Anfrage"
Const ZeileTitel As Long = 4 'Zeile mit den Spaltentiteln im Blatt "Anfrage"
Set wksAnfrage = Worksheets("Anfrage")
Set wksAuftrag = Worksheets("Auftrag")
With wksAuftrag
'Letzte Datenzeile im Blatt "Auftrag", als Spalte (hier 1) eine Spalte wählen, _
in der in jeder Zeile ein Wert eingetragen wird - z.B. Kundenname oder Kunden-Nr.
Zeile_2 = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
Application.ScreenUpdating = False
With wksAnfrage
'Spalten mit Eintrag "x" unter Freigabe kopieren nach Blatt "Auftrag"
For Zeile_1 = ZeileTitel + 1 To .Cells(.Rows.Count, Spalte_X).End(xlUp).Row
If LCase(.Cells(Zeile_1, Spalte_X).Value) = "x" Then
Zeile_2 = Zeile_2 + 1
.Rows(Zeile_1).Copy
wksAuftrag.Cells(Zeile_2, 1).PasteSpecial Paste:=xlPasteValues
wksAuftrag.Cells(Zeile_2, Spalte_X) = Date 'X-Eintrag durch aktuelles Datum ersetzen
End If
Next
Application.CutCopyMode = False
'Zeilen mit "x" von unten nach oben löschen
For Zeile_1 = .Cells(.Rows.Count, Spalte_X).End(xlUp).Row To ZeileTitel + 1 Step -1
If LCase(.Cells(Zeile_1, Spalte_X).Value) = "x" Then
.Rows(Zeile_1).Delete
End If
Next
End With
Application.ScreenUpdating = True
MsgBox "Fertig", vbInformation + vbOKOnly, "Auftrag kopieren/löschen"
End Sub Eine letzte Frage noch... wie kann ich es anstellen, dass das Makro durch ein anklicken der Zelle L1 gestartet wird?
Ich habe es mit folgendem Skript versucht...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$L$1" Then Call Sub Freigabe_Übertragen()
End Sub

das kollidierte aber mit dem ersten


Private Sub Worksheet...
Wieso klappt das nicht und wie kann man es machen, dass es klappt?
LG Matthias

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Select Case Target.Address Case "$A$3", "$B$3", "$C$3", "$D$3", "$E$3", "$F$3", "$G$3", "$H$3", "$I$3", "$J$3", _ "$K$3", "$L$3", "$M$3", "$P$3", "$S$3" Range("A5:AE204").Sort Key1:=Target.Offset(2), Order1:=xlAscending, _ Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Case "$L$1" Call Freigabe_Übertragen End Select End Sub

Beliebteste Forumthreads (12 Monate)

Daten aus einem Tabellenblatt in ein anderes Tabel

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

323 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten aus einem Tabellenblatt in ein anderes Tabel

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

323 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread