Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Daten aus einem Tabellenblatt in ein anderes Tabel

Daten aus einem Tabellenblatt in ein anderes Tabel
Matthias
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

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

Betreff
Benutzer
Anzeige
AW: Daten aus einem Tabellenblatt in ein anderes Tabel
18.06.2011 02:08:16
fcs
Hallo Mathias,
mit dem folgenden Makro, dass du noch an den Aufbau deiner Tabellen anpassen musst, funktioniert es.
Der Makrorekorder von Excel hilft hier nur bedingt weiter und kann nur ein Grundgerüst liefern. Die Logischen Teile muss man "nachrüsten".
Gruß
Franz
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

Anzeige
AW: Daten aus einem Tabellenblatt in ein anderes Tabel
18.06.2011 14:01:51
Matthias
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

Anzeige
AW: Daten aus einem Tabellenblatt in ein anderes Tabel
19.06.2011 01:02:37
fcs
Hallo Mathias,
in jedem Tabellenblatt darf nur eine Ereignis-Prozedur mit dem Namen
"Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)"
angelegt werden.
Alle Zellen, bei deren Selektion Makroaktionen gestartet werden sollen, mussen in dieser einen Prozedur geprüft werden.
Für die Prüfungen benutzt man statt "If ... Then ... End If "in deinem Fall besser eine "Select Case ..." Logik.
Die ist hier übersichtlicher und pflegeleichter.
Zusätzlich beachten: beim Aufruf von anderen Makros per Call-Anweisung entfallt das "Sub" vor dem Makronamen
Gruß
Franz
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

Anzeige

330 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige