sorry, aber ich habe schon wieder ein Problem:
Nachfolgender Code wurde mir hier zur Verfügung gestellt und funktioniert auch. Nur hat sich jetzt an der Struktur der Zieltabelle etwas geändert.
Private Sub CommandButton1_Click()
Dim lRow As Long
Dim sRow As Long
Dim myWks As String
Dim arrTrans, iTrans As Integer, sTrans As String, lSpalte As Long
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim wksQuelle As Worksheet
Dim arrNot As Integer
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.xlsm")
On Error GoTo 0
If wkbZiel Is Nothing Then
Set wkbZiel = Workbooks.Open("\\malibu\Projekte\SAP\300_Test\2011\10_Projekt FI_CO\10_GSZ _
_
Bearbeitung\INFOBOX_FICO.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
'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
Set wksZiel = wkbZiel.Sheets("TA und Stammdaten")
With wksZiel
For lSpalte = 1 To 7
'nächste freie Zeile in Spalte der Zieltabelle finden
lRow = .Cells(.Rows.Count, lSpalte).End(xlUp).Row + 1
'Werte für Spalte aus Zeile in Quelltabelle in Variable einlesen
Select Case lSpalte
Case 1 'Transaktions-Typen in Quellzeile Spalte D(4)
sTrans = wksQuelle.Cells(sRow, 4).Text
'Sonderzeichen in Transaktions-Typ. ersetzen
sTrans = Replace(sTrans, ";", "")
sTrans = Replace(sTrans, "=", "")
sTrans = Replace(sTrans, " ", " ")
sTrans = Replace(sTrans, " ", " ")
Case 2: sTrans = wksQuelle.Cells(sRow, 12).Text 'Spalte L - Debitoren
Case 3: sTrans = wksQuelle.Cells(sRow, 13).Text 'Spalte M - Kreditoren
Case 4: sTrans = wksQuelle.Cells(sRow, 14).Text 'Spalte N - Artikel
Case 5: sTrans = wksQuelle.Cells(sRow, 15).Text 'Spalte O - Profitcenter
Case 6: sTrans = wksQuelle.Cells(sRow, 16).Text 'Spalte P - Kostenstelle
Case 7: sTrans = wksQuelle.Cells(sRow, 17).Text 'Spalte Q - Innenauftrag
End Select
If Trim(sTrans) "" Then
'Werte am Leerzeichen splitten und in Array einlesen. _
Dabei Leerzeichen am Anfang/Ende löschen.
arrTrans = Split(Trim(sTrans), " ")
'Transaktionen bzw. Daten aus Spalten L bis Q in Zielblatt eintragen, ggf. _
in mehreren Zeilen
For iTrans = 0 To UBound(arrTrans)
'Transaktions-Typ und Daten eintragen
.Cells(lRow + iTrans, lSpalte).Value = arrTrans(iTrans)
Next
'Doppelte Datenzeilen entfernen - funktioniert nur unter Excel 2007
lRow = .Cells(.Rows.Count, lSpalte).End(xlUp).Row
If lRow > 2 Then
.Range(.Cells(1, lSpalte), .Cells(lRow, lSpalte)).RemoveDuplicates _
Columns:=Array(1), Header:=xlYes
End If
'Daten in Spalte aufsteigend sortieren
lRow = .Cells(.Rows.Count, lSpalte).End(xlUp).Row
If lRow > 2 Then
With .Range(.Cells(1, lSpalte), .Cells(lRow, lSpalte))
.Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
End With
End If
End If
Next
End With
wkbZiel.Close True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Nachfolgend drei Beispieltabellen. In der Zieltabelle sind Spalten hinzugefügt worden, sodaß das kopieren von der Quelltabbe zur Zieltabelle nach dem Muster der Beispieltabellen erfolgen soll. Ich denke, daß die Änderung des Codes in der fett gekennzeichneten Stelle erfolgen muß (sicher bin ich mir aber nicht)
Quelltabelle:
FI
L | M | N | O | P | Q | |
2 | Debitoren | Kreditoren | Artikel | Profitcenter | Kostenstelle | Innenauftrag |
3 | test01 | test02 | test03 | test04 | test05 | test06 |
4 | ||||||
5 | ||||||
6 |
Tabellendarstellung in Foren Version 5.39
neue Zieltabelle:
TA und Stammdaten
B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | |
1 | Debitoren IST | Debitoren SOLL | Debioren Land | Kreditoren IST | Kreditoren SOLL | Kreditoren Land | Artikel IST | Artikel SOLL | Artikel Land | Profitcenter IST | Profitcenter SOLL | Profitcenter Land | Kostenstelle IST | Kostenstelle SOLL | Kostenstelle Land | Innenauftrag IST | Innenauftrag SOLL | Innenauftrag Land |
2 | test01 | test02 | test3 | test04 | test05 | test06 | ||||||||||||
3 |
Tabellendarstellung in Foren Version 5.39
alte Zieltabelle (zum Nachvollziehen der Strukturänderung):
TA und Stammdaten
B | C | D | E | F | G | H | |
1 | Debitoren | Kreditoren | Artikel | Profitcenter | Kostenstelle | Innenauftrag | |
2 | test01 | test02 | test03 | test04 | test05 | test06 | |
3 | |||||||
4 |
Tabellendarstellung in Foren Version 5.39
Kann mir hiermit jemand weiterhelfen?
Viele Grüße
Stefan