Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Daten in anderes Tabellenblatt kopieren
Stefan
Hallo,
ich habe mal wieder ein Problem:
folgender Code wurde mir hier zur Verfügung gestellt und funktioniert auch:
Private Sub CommandButton1_Click()
Dim lRow As Long
Dim sRow As Long
Dim myWks As String
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim wksQuelle As Worksheet
Set wksQuelle = ActiveSheet
'Ursprungstabelle: Daten kopieren
myWks = Range("B" & Selection.Row).Value
Selection.Copy
sRow = Selection.Row
On Error Resume Next
Set wkbZiel = Workbooks("INFOBOX_FICO_test.xlsm")
On Error GoTo 0
If wkbZiel Is Nothing Then
Set wkbZiel = Workbooks.Open("c:\test\INFOBOX_FICO_test.xlsm") 'anpassen
End If
Set wksZiel = wkbZiel.Sheets(myWks)
'Bildschirmaktualisierung und Ereignismakros deaktivieren
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
With wksZiel
'letzte freie Zeile der Zieltabelle finden
lRow = .Cells(Rows.Count, 2).End(xlUp).Row + 1
'Ursprungsdatensatz einfügen
.Range("K" & lRow).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
'String-Zerteilungs Formeln einfügen
.Range("B" & lRow).FormulaR1C1 = "=LEFT(RC[9],13)"
.Range("C" & lRow).FormulaR1C1 = "=MID(RC[8],15,9^9)"
.Range("G" & lRow).FormulaR1C1 = "=MID(RC[4],15,2)"
.Range("H" & lRow).FormulaR1C1 = "=RIGHT(RC[3],3)"
.Range("B" & lRow & ":H" & lRow).Value = .Range("B" & lRow & ":H" & lRow).Value
.Columns("K:K").ClearContents
End With
'Transaktionen kopieren
wksQuelle.Range("D" & sRow).Copy
wksZiel.Range("F" & lRow).PasteSpecial Paste:=xlValues
'Testart kopieren
wksQuelle.Range("E" & sRow).Copy
wksZiel.Range("D" & lRow).PasteSpecial Paste:=xlValues
wkbZiel.Close True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Der Code leistet folgendes: Nach Markieren einer Zelle in Spalte C der Quelltabelle und klicken auf einen Button werden die Daten der Spalten C, D und E der Quelltabelle in die Zielmappe übertragen, und zwar in das Tabellenblatt der Zielmappe, das die gleiche Benamung besitzt wie in Spalte B der Quelltabelle eingetragen ist. Dabei werden die Daten aus Spalte C der Quelle in der Zieltabelle gesplittet auf verschiedene Salten. Die Zieltabelle öffnet und schließt automatisch im Hintergrund.
Meine Frage ist, ob man diesen Code folgendermaßen erweitern kann:
In der Quelltabelle wurden nachträglich folgende Spalten eingefügt :
L M N O P Q
Debitoren Kreditoren Artikel Profitcenter Kostenstelle Innenauftrag
außerdem gibt es eine Spalte D "Transaktionen".
In der Zielmappe gibt es ein Tabellenblatt "TA und Stammdaten" mit den Spalten
A B C D E F G
Transaktionen Debitoren Kreditoren Artikel Profitcenter Kostenstelle Innenauftrag
Jetzt soll obiger Code so geändert werden, daß die Einträge aus der Quelltabelle (Spalten D, L - Q) in das Tabellenblatt "TA und Stammdaten" der Zielmappe vor deren automatischem Schließen entsprechend der Spaltenüberschriften übertragen werden. Dabei gibt es bei Spalte D "Transaktionen" noch folgendes zu beachten:
In der Quellzelle (z.Bsp. D3) können unter Umständen mehrere Transaktionen stehen , die in der Zieltabelle getrennt sein sollen (z.Bsp. A3 und A4). Das Problem ist, daß die Transaktionsbezeichnungen unterschiedliche Länge haben. Aber vor und nach jeder Transaktionsbezeichnung steht ein blank. Sonst sind keine blanks vorhanden.
Nachfolgender Code wurde mir hier schon einmal zur Verfügung gestellt (der aber separat abläuft, dabei nur die Spalte D "Transaktionen" behandelt und innerhalb der Zielmappe von einem Blatt zum anderen kopiert, das aber wie oben beschrieben geändert werden soll):
Sub TransaktListeMark() ' bearbeitet markierte Zellen in Spalte D
Dim MyDic, Kys, arrNot, lngA As Long, ii As Long
Dim arrW, arrT, zz As Long, tt As Long
arrNot = Split("+?+ + ?( /oder/ / ) ", " ")
lngA = UBound(arrNot)
Set MyDic = CreateObject("Scripting.Dictionary")
With Sheets("TA und Stammdaten") ' bisherige Transakt.
zz = .Cells(.Rows.Count, 1).End(xlUp).Row
If zz > 1 Then
arrW = .Cells(2, 1).Resize(zz - 1)
For zz = 1 To UBound(arrW)
On Error Resume Next
MyDic.Add arrW(zz, 1), 1
On Error GoTo 0
Next zz
End If
End With
With Sheets("GSZ_OP_TA_BSP") ' neue Transakt.
.Activate
arrW = Intersect(.Columns(6), Selection)
For zz = 1 To UBound(arrW)
arrT = Split(arrW(zz, 1), " ")
For tt = 0 To UBound(arrT)
For ii = 0 To lngA
If arrT(tt) = arrNot(ii) Then Exit For
Next ii
If ii > lngA Then
On Error Resume Next
MyDic.Add arrT(tt), 1
On Error GoTo 0
End If
Next tt
Next zz
End With
Kys = MyDic.Keys ' Ausgabe Transakt.
Sheets("TA_Liste").Cells(2, 1).Resize(MyDic.Count) = _
Application.Transpose(Kys)
Set MyDic = Nothing
End Sub
Ich hoffe ich habe mich verständlich ausgedrückt. Kann mir hierbei jemand helfen?
Viele Grüße
Stefan
AW: Daten in anderes Tabellenblatt kopieren
01.04.2011 11:39:42
fcs
Hallo Stefan,
hier mein Vorschlag zur Anpassung. Natürlich ungetestet, da Beispieldaten fehlen.
Gruß
Franz
Private Sub CommandButton1_Click()
Dim lRow As Long
Dim sRow As Long
Dim myWks As String
Dim arrTrans, iTrans As Integer
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim wksQuelle As Worksheet
Set wksQuelle = ActiveSheet
'Ursprungstabelle: Daten kopieren
myWks = Range("B" & Selection.Row).Value
Selection.Copy
sRow = Selection.Row
On Error Resume Next
Set wkbZiel = Workbooks("INFOBOX_FICO_test.xlsm")
On Error GoTo 0
If wkbZiel Is Nothing Then
Set wkbZiel = Workbooks.Open("c:\test\INFOBOX_FICO_test.xlsm") 'anpassen
End If
Set wksZiel = wkbZiel.Sheets(myWks)
'Bildschirmaktualisierung und Ereignismakros deaktivieren
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
With wksZiel
'letzte freie Zeile der Zieltabelle finden
lRow = .Cells(Rows.Count, 2).End(xlUp).Row + 1
'Ursprungsdatensatz einfügen
.Range("K" & lRow).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
'String-Zerteilungs Formeln einfügen
.Range("B" & lRow).FormulaR1C1 = "=LEFT(RC[9],13)"
.Range("C" & lRow).FormulaR1C1 = "=MID(RC[8],15,9^9)"
.Range("G" & lRow).FormulaR1C1 = "=MID(RC[4],15,2)"
.Range("H" & lRow).FormulaR1C1 = "=RIGHT(RC[3],3)"
.Range("B" & lRow & ":H" & lRow).Value = .Range("B" & lRow & ":H" & lRow).Value
.Columns("K:K").ClearContents
End With
'Transaktionen kopieren
wksQuelle.Range("D" & sRow).Copy
wksZiel.Range("F" & lRow).PasteSpecial Paste:=xlValues
'Testart kopieren
wksQuelle.Range("E" & sRow).Copy
wksZiel.Range("D" & lRow).PasteSpecial Paste:=xlValues
'Daten aus selektierter Zeile in Quelle in Blatt "TA und Stammdaten" der _
Zieldatei eintragen
Set wksZiel = wkbZiel.Sheets("TA und Stammdaten")
With wksZiel
'letzte freie Zeile der Zieltabelle finden
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
'Transaktionen in Quellzeile Spalte D(4) am Leerzeichen splitten und in Array _
einlesen. Dabei Leerzeichen am Anfang/Ende löschen und doppelte Leerzeichen _
durch 1 Leerzeichen ersetzen.
arrTrans = Split(Replace(Trim(wksQuelle.Cells(sRow, 4).Text), "  ", " "), " ")
'Spalten L(12) bis Q(17) aus selektierter Zeile in Quelle kopieren
With wksQuelle
.Range(.Cells(sRow, 12), .Cells(sRow, 17)).Copy
End With
'Transaktionen und Daten aus Spalten L bis Q in Zielblatt eintragen, ggf. _
in mehreren Zeilen
For iTrans = 0 To UBound(arrTrans)
.Cells(lRow + iTrans, 1).Value = arrTrans(iTrans)
.Cells(lRow + iTrans, 2).PasteSpecial Paste:=xlValues
Next
Application.CutCopyMode = False
End With
wkbZiel.Close True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Anzeige
AW: Daten in anderes Tabellenblatt kopieren
01.04.2011 18:09:53
Stefan
Hallo,
ich habe den Code getestet. Vielen Dank. Ich habe allerdings noch zwei Proleme.
1. Beim übertragen in die Zieltabellen sollte noch überprüft werden, daß keine doppelte Einträge vermieden werden.
2. Beim Übertragen von der Quelle Spalte D "Transaktinen" in Zieltabelle "TA und Stammdaten" sollte das Übertragen von Sonderzeichen (+, ?, /, , ) vermieden werden. Vielleicht ist folgende Stelle im Code zu vervollständigen.
'Transaktionen in Quellzeile Spalte D(4) am Leerzeichen splitten und in Array _
einlesen. Dabei Leerzeichen am Anfang/Ende löschen und doppelte Leerzeichen _
durch 1 Leerzeichen ersetzen.
arrTrans = Split(Replace(Trim(wksQuelle.Cells(sRow, 4).Text), " ", " "), " ")
Kannst du mir hier noch weiterhelfen?
Viele Grüße
Stefan
Anzeige
AW: Daten in anderes Tabellenblatt kopieren
01.04.2011 19:03:34
fcs
Hallo Stefan,
mit folgenden Ergänzungen/Anpassungen werden die Sonderzeichen ersetzt und doppelte Zeilen wieder gelöscht.
Das Entfernen der doppelten Einträge funktioniert nur unter Excel 2007 und neuer. Wenn dies auch mit älteren Excelversionen funktionieren soll, dann muss man die Zeilen zeilenweise beginnend vom Ende der Liste vergleichen und doppelte löschen.
Gruß
Franz
    'Transaktionen und Daten aus Spalten L bis Q in Zielblatt eintragen, ggf. _
in mehreren Zeilen
For iTrans = 0 To UBound(arrTrans)
'Sonderzeichen in Transaktions-Typ. ersetzen
arrTrans(iTrans) = Replace(arrTrans(iTrans), "?", "")
arrTrans(iTrans) = Replace(arrTrans(iTrans), "/", "")
arrTrans(iTrans) = Replace(arrTrans(iTrans), "+", "")
'Transaktions-Typ und Daten eintragen
.Cells(lRow + iTrans, 1).Value = arrTrans(iTrans)
.Cells(lRow + iTrans, 2).PasteSpecial Paste:=xlValues
Next
Application.CutCopyMode = False
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'Doppelte Datenzeilen entfernen - funktioniert nur unter Excel 2007 und neuer
' 1. Zeile (mit Spaltentiteln) des Bereichs und die beim Vergleichen zu _
berücksichtigenden Spalten im Array ggf. anpassen
.Range(.Cells(1, 1), .Cells(lRow, 7)).RemoveDuplicates _
Columns:=Array(1, 2, 3, 4, 5, 6, 7), Header:=xlYes
End With

Anzeige
AW: Daten in anderes Tabellenblatt kopieren
02.04.2011 08:08:25
Stefan
Hallo,
ich habe die Ergänzung getestet. Das Ersetzen der Sonderzeichen funktioniert prima. Das Entfernen der
doppelten Einträge nicht. Ich nutze Excel 2007. Ich habe 2 Beispieldateien hochgeladen. Außerdem habe ich noch eine Ist-Ansicht der Tabelle "TA und Stammdaten" nach dem Ausführen des Codes und eine Soll-Ansicht sowie eine Ansicht der Quelltabelle "FI". Vielleicht hilft es etwas.
https://www.herber.de/bbs/user/74248.xlsm
https://www.herber.de/bbs/user/74249.xlsm
74248.xlsm ist die Quelldatei
74249.xlsm ist die Ziedatei
Quelltabelle:
FI
 ABCDEFGHIJKLMNOPQR
1Thema    Quelltabelle    StammdatenÜberarbeitung                   
2Mitglied belastet EPH mit WKZ
EP: GS an Kunde auf Anfrage
BBP_ALLGSZ AufstellungTransaktionenTestartStatusArtikelTestinhaltAbschlussarbeiten    DebitorenKreditorenArtikelProfitcenterKostenstelleInnenauftrag 
3  GSZ_OP_TA_HBHGSZ_6000_K038_DE_light_FT_RE_CPD_Konto_buchen_V1_JTHFB60  in Planungnicht notwendig   JTH    test01 test00           
4  GSZ_OP_TA_HBHGSZ_6000_K700_DE_light_FT_RE_CPD_Konto_buchen_V1_JTHF-47 + F-48              test01 test01test02         
5  GSZ_OP_TA_KrediGSZ_6000_K900_DE_light_FT_RE_CPD_Konto_buchen_V1_JTHF-47 + F-48F            test01 test02test03test04 test05test06 test07     
6  GSZ_OP_TA_DebiGSZ_6000_K006_DE_light_FT_GS_an_Mitglied_Verrechnung_Fälligk_manuell_Abb_V1_RAMFB75 /?/ F-13Fin Arbeit  Daten ergänzen + StammdatenMVI    test11 test12test13 test14test15       
7                                   
8                                   

Tabellendarstellung in Foren Version 5.39


Zieltabelle:
Ist nach Ausführen des Codes
TA und Stammdaten
 ABCDEFG
1Ist nach Ausführen des Codes           
2verarbeitete TransaktionenDebitorenKreditorenArtikelProfitcenterKostenstelleInnenauftrag
3F-47test01 test02test03test04 test05test06 test07   
4  test01 test02test03test04 test05test06 test07   
5F-48test01 test02test03test04 test08     
6FB75test11 test12test13 test14test15     
7  test11 test16test13 test14test15     
8F-13test11 test17test13 test14test15     

Tabellendarstellung in Foren Version 5.39


Soll nach Ausführen des Codes
TA und Stammdaten
 ABCDEFGH
14Soll nach Ausführen des Codes             
15verarbeitete TransaktionenDebitorenKreditorenArtikelProfitcenterKostenstelleInnenauftrag 
16F-47test01test03test04test06     
17F-48test02test13test05test07     
18FB75test11test14test15       
19F-13test12           
20  test16           
21  test17           
22               

Tabellendarstellung in Foren Version 5.39


Viele Grüße
Stefan
Anzeige
AW: Daten in anderes Tabellenblatt kopieren
02.04.2011 18:03:00
fcs
Hallo Stefan,
mir war nicht klar, dass im Stammdatenblatt in jeder Spalte die Einträge am Leerzeichen zu splitten waren und dann die doppelten entfernt werden sollten.
Ich hab die Prozedur für den Commandbutton jetzt in diese Richtung angepasst.
https://www.herber.de/bbs/user/74255.txt
Gruß
Franz
AW: Daten in anderes Tabellenblatt kopieren
02.04.2011 21:39:45
Stefan
Hallo Franz,
der Code funktioniert hervorragend bis auf ein Problem. Es erscheinen noch doppelte Daten an folgender Stelle, also beim Übertragen von der Quelltabelle "Brainstorming_FI_CO_test" in die einzelnen Zielarbeitsblätter (z.Bsp. "GSZ_OP_TA_HBH"). Hier sollen die Datensätze nur einmal auftauchen. Als Schlüssel hierfür kann die Spalte B "GSZ-Ketten Nr" dienen. Nachfolgend ein Beispiel (gelb unterlegt die doppelte, dementsprechend soll einer dieser Datensätze gelöscht werden)
GSZ_OP_TA_HBH
 ABCDEFGHIJK
1Zähler (Beispiel)GSZ-Ketten NrGSZ NameFunktionstest (F)
Integrationstest (I)
Schnittstellentest(SST)
Prozess /GeschäftsvorfallTransaktionLandErstellerOP (X)Bemerkungen 
2  GSZ_6000_K025DE_light_FT_Aufl_RST_MM_HBH_V1_SPAF  FB50DESPA     
3  GSZ_6000_K026DE_light_FT_Inanspruch_RST_MM_HBH_V1_SPAF  FB60DESPA     
4  GSZ_6000_K043DE_light_FT_Inanspruch_RST_Korr_MM_HBH_V1_SPAF  FB50 + FB60DESPA     
5  GSZ_6000_K500DE_light_FT_Inanspruch_RST_Korr_MM_HBH_V1_SPAF  FB50 + FB60DESPA     
6  GSZ_6000_K700DE_light_FT_RE_CPD_Konto_buchen_V1_JTH    F-47 + F-48DEJTH     
7  GSZ_6000_K700DE_light_FT_RE_CPD_Konto_buchen_V1_JTH    F-47 + F-48DEJTH     
8                     
9                     

Tabellendarstellung in Foren Version 5.39


Vielen Grüße
Stefan
Anzeige
AW: Daten in anderes Tabellenblatt kopieren
04.04.2011 08:25:21
fcs
Hallo Stefan,
zum Entfernen der Doppelten in der 1. Zieltabelle in der Prozedur die Anweisungen in der Prozedur nach dem Übertragen aller Daten einfügen.
Gruß
Franz
  'Testart kopieren
wksQuelle.Range("E" & sRow).Copy
wksZiel.Range("D" & lRow).PasteSpecial Paste:=xlValues
'Doppelte (in Spalte B) Datenzeilen entfernen - funktioniert nur unter Excel 2007
With wksZiel
lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
If lRow > 2 Then
.UsedRange.RemoveDuplicates Columns:=Array(2), Header:=xlYes
End If
End With
'Daten aus selektierter Zeile in Quelle in Blatt "TA und Stammdaten" der _
Zieldatei eintragen

Anzeige
AW: Daten in anderes Tabellenblatt kopieren
04.04.2011 12:15:29
Stefan
Hallo Franz,
funktioniert prima. Vielen Dank. Du hast mir sehr geholfen.
Viele Grüße
Stefan

351 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige