Zellen aus Datei1 nach Datei2 kopieren!

Anna4621 · 10. November 2019 um 12:20

Hallo alle Zusammen.

Ich habe Excel 2002!Und sehr wenig Ahnung von VB!
Ich habe eine Datei in der eine Stausspalte enthalten ist.
Ich möchte, dass immer der Wert „(+)“ gesucht wird.Anschließend sollen jeweils aus der Zeile,in der dieser Wert als Status vorhanden ist, die Werte aus den Spalten B,C,F,J,E genommen werden und in eine andere Tabelle(andere Datei) kopiert werden.
Dabei sollen die Werte aus der Spalte B(Datei1) nach Spalte C(Datei2) kopiert werden. C(D1) nach D(D2); F(D1) nach E(D2); J(D1) nach F(D2);E(D1) nachG(D2).
Kann mir jemand helfen?
Vielen Dank schonmal im Voraus!

Grüße Anna

Anna4621 · 10. November 2019 um 12:21

Ich hatte vergessen zu erwähnen, dass das ganze durch einen Button aktiviert wird bzw. werden soll!
Hatte gedacht,dass kann man mit einer schleife machen.Bin nur noch nicht sehr weit gekommen:
Sub Schaltfläche178_BeiKlick()
Dim currentColumn As Range
currentColumn = 6
If Value = „(+)“ Then
------------- da fehlt es!
End Sub
Kann mir jemand helfen?Bitte!

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

Reinhard_fb8cb7 · 10. November 2019 um 12:21

Ich möchte, dass immer der Wert „(+)“ gesucht
wird.Anschließend sollen jeweils aus der Zeile,in der dieser
Dabei sollen die Werte aus der Spalte B(Datei1) nach Spalte
C(Datei2) kopiert werden. C(D1) nach D(D2); F(D1) nach E(D2);
J(D1) nach F(D2);E(D1) nachG(D2).

Hi Anna,

Option Explicit
'
Sub tt()
Dim Zei1 As Long, wks1 As Worksheet, Zei2 As Long, wks1 As Worksheet
Set wks1 = Workbooks("Datei1.xls").Worksheets("Tabelle1")
Set wks2 = Workbooks("Datei2.xls").Worksheets("Tabelle1")
With wks1
 For Zei = 1 To .Range("A" & Rows.Count).End(xlUp).Row
 If .Cells(Zei, 1) = "+" Then
 Zei2 = Zei2 + 1
 wks2.Cells(Zei2, 3) = .Cells(Zei1, 2) 'b-\>C
 wks2.Cells(Zei2, 4) = .Cells(Zei1, 3) 'c-\>d
 wks2.Cells(Zei2, 5) = .Cells(Zei1, 6) 'f-\>e
 wks2.Cells(Zei2, 6) = .Cells(Zei1, 10) 'j-\>F
 wks2.Cells(Zei2, 7) = .Cells(Zei1, 5) 'e-\>g
 End If
 Next Zei
End With
End Sub

Gruß
Reinhard

Anna4621 · 10. November 2019 um 12:21

Hallo Reinhard,

erstmals vielen Dank für deine Hilfe!
Funktioniert leider noch nicht!
MEin Befehl sieht so aus:

Option Explicit
'
Sub tt()
Dim Zei1 As Long, wks1 As Worksheet, Zei2 As Long, wks2 As Worksheet, Zei As String
Set wks1 = Workbooks("Start.xls").Worksheets("Tabelle3")
Set wks2 = Workbooks("Ziel.xls").Worksheets("Tabelle13")
With wks1
 For Zei = 1 To .Range("F" & Rows.Count).End(xlUp).Row
 If .Cells(Zei, 1) = "(+)" Then
 Zei2 = Zei2 + 1
 wks2.Cells(Zei2, 3) = .Cells(Zei1, 2) 'b-\>C
 wks2.Cells(Zei2, 4) = .Cells(Zei1, 3) 'c-\>d
 wks2.Cells(Zei2, 5) = .Cells(Zei1, 6) 'f-\>e
 wks2.Cells(Zei2, 6) = .Cells(Zei1, 10) 'j-\>F
 wks2.Cells(Zei2, 7) = .Cells(Zei1, 5) 'e-\>g
 End If
 Next Zei
End With
End Sub

Und bei mir kommt die Fehlermeldung: Typenunverträglichkeit und das „Zei“ in der Zeile „For Zei =…“ wird markiert.
Kannst Du mir helfen?Was mache ich falsch?

Liebe Grüsse
Anna

[MOD] - Pre-Tag eingefügt.

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

Reinhard_fb8cb7 · 10. November 2019 um 12:21

Und bei mir kommt die Fehlermeldung: Typenunverträglichkeit
und das „Zei“ in der Zeile „For Zei =…“ wird markiert.
Kannst Du mir helfen?Was mache ich falsch?

Hi Anna,

benutze bitte beim Posten von Code den Pre-Tag, wird unterhalb des Eingabefeldes erläutert, dann bleiben Einrückungen im Code erhalten.

Sorry, mein Fehler, hatte die 1 hinten bei Zei vergessen, werfe also wieder „, Zei as String“ wieder raus bzw. nimm diesen Code:

Option Explicit
'
Sub tt()
Dim Zei1 As Long, wks1 As Worksheet, Zei2 As Long, wks1 As Worksheet
Set wks1 = Workbooks("Datei1.xls").Worksheets("Tabelle1")
Set wks2 = Workbooks("Datei2.xls").Worksheets("Tabelle1")
With wks1
 For Zei1 = 1 To .Range("A" & Rows.Count).End(xlUp).Row
 If .Cells(Zei1, 1) = "+" Then
 Zei2 = Zei2 + 1
 wks2.Cells(Zei2, 3) = .Cells(Zei1, 2) 'b-\>C
 wks2.Cells(Zei2, 4) = .Cells(Zei1, 3) 'c-\>d
 wks2.Cells(Zei2, 5) = .Cells(Zei1, 6) 'f-\>e
 wks2.Cells(Zei2, 6) = .Cells(Zei1, 10) 'j-\>F
 wks2.Cells(Zei2, 7) = .Cells(Zei1, 5) 'e-\>g
 End If
 Next Zei1
End With
End Sub

Gruß
Reinhard

Anna4621 · 10. November 2019 um 12:21

Danke für deine Hilfe!Es wird immer noch eine Fehlermeldung anzeigt und zwar: Laufzeitfehler ‚9‘ Index außerhalb der gültigen Bereichs!
Der Fehler liegt vermutlich in der ersten Zeile:

Dim Zei1 As Long, wks1 As Worksheet, Zei2 As Long, wks2 As Worksheet

musste aus dem zweiten „wks1“ ein „wks2“ machen.Hatte da auch eine Fehlermeldung.
Weißt Du eine Lösung?
Vielen Dank!
Liebe Grüsse Anna

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

Reinhard_fb8cb7 · 10. November 2019 um 12:22

Hallo Anna,

musste aus dem zweiten „wks1“ ein „wks2“ machen.Hatte da auch
eine Fehlermeldung.

scheinbar ist heute nicht mein Tag daß ich so Code ungetestet einfach so schreibe *seufz*

Okay, beginnen wir unsre „Beziehung“ völlig neu, du postest hier bitte exakt den aktuellen Code den du benutzt und wodrin der aktuelle Fehler auftritt.

Ich kann es dann hinbiegen daß der Code funktioniert, diesmal mit Testung, bislang habe ich nur ungetestet geantwort *faule Socke bin*
Und bei der Lösung kann nix schiefgehen, außer du hast da Datümer (ja, so ist die Mehrzahl von Datum), verbundene Zellen, Gruppierungen, Passwörter oder sonstige Erschwernisse in den Tabellen/Dateien.

Gruß
Reinhard

Anna4621 · 10. November 2019 um 12:23

Hallo Reinhard,

erstmal meinen Befehl:

_{Option Explicit

Sub tt()
Dim Zei1 As Long, wks1 As Worksheet, Zei2 As Long, wks2 As Worksheet
Set wks1 = Workbooks(„Start.xls“).Worksheets(„Tabelle3“)
Set wks2 = Workbooks(„Ziel.xls“).Worksheets(„Tabelle13“)
With wks1
For Zei1 = 1 To .Range(„F“ & Rows.Count).End(xlUp).Row
If .Cells(Zei1, 1) = „(+)“ Then
Zei2 = Zei2 + 1
wks2.Cells(Zei2, 3) = .Cells(Zei1, 2) 'b->C
wks2.Cells(Zei2, 4) = .Cells(Zei1, 3) 'c->d
wks2.Cells(Zei2, 5) = .Cells(Zei1, 6) 'f->e
wks2.Cells(Zei2, 6) = .Cells(Zei1, 10) 'j->F
wks2.Cells(Zei2, 7) = .Cells(Zei1, 5) 'e->g
End If
Next Zei1
End With
End Sub}

Danke für deine Hilfe!
Also jetzt mal ein paar Detail, die Dir die Arbeit hoffentlich leichter machen:

Datei1 enthält die Stautustabelle zu Projekt AX
Datei2 hat eine Ergebnistabelle zu allen Projekten AX - ZX
jedes Projekt hat seine eigene Ergebniszeile
der kopierte Inhalt von AX soll in die Zeile AX, wenn es mehr wie eine zu kopierende Zeile gibt sollen diese darunter eingefügt werden und die restliche Ergebnistabelle soll nach unten verrückt werden --> AX steht in der dritten Zeile und es sollen 13 Zeilen Kopien eingefügt werden, dann soll BX nach Zeile17 rutschen.Verständlich?
Die Projektnamen stehen in der ersten Datei in der Zelle I 66 und der zweiten Datei in der Spalte A.

Vielen lieben Dank!
Du kannst mir auch gerne eine andere Lösung vorschlagen, falls meine Wünsche sich nicht umsetzen lassen!

Liebe Grüsse Anna

Reinhard_fb8cb7 · 10. November 2019 um 12:23

Hi Anna,

erstmal meinen Befehl:

naja, das mit dem pre-Tag müssen wir aber noch ma üben

Also jetzt mal ein paar Detail, die Dir die Arbeit hoffentlich
leichter machen:

Datei1 enthält die Stautustabelle zu Projekt AX

Datei2 hat eine Ergebnistabelle zu allen Projekten AX - ZX

jedes Projekt hat seine eigene Ergebniszeile

der kopierte Inhalt von AX soll in die Zeile AX, wenn es
mehr wie eine zu kopierende Zeile gibt sollen diese darunter
eingefügt werden und die restliche Ergebnistabelle soll nach
unten verrückt werden --> AX steht in der dritten Zeile und
es sollen 13 Zeilen Kopien eingefügt werden, dann soll BX nach
Zeile17 rutschen.Verständlich?
Die Projektnamen stehen in der ersten Datei in der Zelle I 66
und der zweiten Datei in der Spalte A.

Hier ist eine Datei die das macht was ich verstanden habe.

http://www.hostarea.de/server-08/August-e70cb2e9ed.xls

und hat folgenden Code unter der Schaltfläche:

Option Explicit
'
Sub tt()
Dim Zei1 As Long, wks1 As Worksheet, Zei2 As Long, wks2 As Worksheet
Dim Awf As WorksheetFunction
Set Awf = Application.WorksheetFunction
'Set wks1 = Workbooks("Start.xls").Worksheets("Tabelle3")
'Set wks2 = Workbooks("Ziel.xls").Worksheets("Tabelle13")
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
With wks1
 If Awf.CountIf(wks2.Columns(1), .Range("I66")) \> 0 Then
 Zei2 = Awf.Match(.Range("I66"), wks2.Columns(1), 0)
 While wks2.Cells(Zei2 + 1, 1) = .Range("I66")
 Zei2 = Zei2 + 1
 Wend
 If wks2.Cells(Zei2, Columns.Count).End(xlToLeft).Column = 1 Then
 wks2.Rows(Zei2).Delete
 Else
 Zei2 = Zei2 + 1
 End If

 For Zei1 = 1 To .Range("A" & Rows.Count).End(xlUp).Row
 If .Cells(Zei1, 1) = "+" Then
 wks2.Rows(Zei2).Insert
 wks2.Cells(Zei2, 1) = .Range("I66")
 wks2.Cells(Zei2, 3) = .Cells(Zei1, 2) 'b-\>C
 wks2.Cells(Zei2, 4) = .Cells(Zei1, 3) 'c-\>d
 wks2.Cells(Zei2, 5) = .Cells(Zei1, 6) 'f-\>e
 wks2.Cells(Zei2, 6) = .Cells(Zei1, 10) 'j-\>F
 wks2.Cells(Zei2, 7) = .Cells(Zei1, 5) 'e-\>g
 End If
 Next Zei1
 Else
 MsgBox "Projekt " & .Range("I66") & " nicht gefunden."
 End If
End With
End Sub

Gruß
Reinhard

Anna4621 · 10. November 2019 um 12:23

Set wks2 = Workbooks(„Ziel.xls“).Worksheets(„Tabelle13“)

Hi Reinhard,

erstmal vielen Dank!
Der Befehl funktioniert leider noch nicht!
Für die oben genannte Zeile kommt der Laufzeitfehler 9: Index liegt außerhalb des gültigen Bereichs.
Woran könnte das liegen?

Liebe Grüsse Anna

Reinhard_fb8cb7 · 10. November 2019 um 12:24

Set wks2 = Workbooks(„Ziel.xls“).Worksheets(„Tabelle13“)

Für die oben genannte Zeile kommt der Laufzeitfehler 9: Index
liegt außerhalb des gültigen Bereichs.
Woran könnte das liegen?

Hallo Anna,

das ist einfach, entweder existiert zu der Laufzeit des Codes die Mappe Ziel.xls nicht und/oder sie enthält nicht ein tabellenblatt was den exakten Namen Tabelle13 trägt.

Irgendwie scheint es so zu sein, daß du meine Codes, die natürlich nicht auf deine Dateinamen, Blattnamen, Ordnerpfade usw. abgestimmt sind, umsetzen kannst.
Ist nicht schlimm, kriegen wir hin.
Am besten wäre natürlich ich hätte deine originaldateien, da könnte ich meinen Code schon einpassen.
Aus Datenschutzgründen geht das wahrscheinlich nicht und ist auch gar nicht erforderlich.
Dann bastle mal bitte 2 Beispieldateien die in der Dateistruktur identisch sind und fülle sie mit Daten und lade die hoch.

Und zum Set Befehl,

Wenn ich Code schreibe wo steht
Set wks1=Worksheets(„Tabelle1“)
Set wks2=Worksheets(„Tabelle2“)

dann teste ich den Code in/auf meinen Blättern Tabelle1 und Tabelle2.

Deine Mappennamen nachzustellen macht keiner.

Also mußt du schon versuchen zu verstehen, was
Set wks1=Workbooks(„Datei1.xls“).Worksheets(„Tabelle1“)
Set wks2=Workbooks(„Datei2.xls“).Worksheets(„Tabelle1“)

bedeutet, d.h. wenn deine Quelldatei xyz.xls heißt, mußt du oben Datei1.xls durch xyz.xls ersetzen, heißt das Baltt nicht Tabelle1 sondern abc mußt du das auch abändern.

Dann ist der Index-Fehler weg.

Gruß
Reinhard

Anna4621 · 10. November 2019 um 12:25

Hallo Reinhard,

habe meinen Fehler gefunden!Danke!
Jetzt gibt es nut noch ein Problem:
das gewünschte Projekt wird nicht gesucht, sondern gelöscht!

If wks2.cells(Zei2, Columns.Count).End(xlToLeft).Column = 1 Then
 wks2.Rows(Zei2).Delete

Liebe Grüsse Anna

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

Reinhard_fb8cb7 · 10. November 2019 um 12:25

habe meinen Fehler gefunden!Danke!
Jetzt gibt es nut noch ein Problem:
das gewünschte Projekt wird nicht gesucht, sondern gelöscht!

If wks2.cells(Zei2, Columns.Count).End(xlToLeft).Column = 1
Then
wks2.Rows(Zei2).Delete

Hallo Anna,

ja und? Das gehört zur Codelogik, danach wirds ja wieder eingefügt.

Angenommen das Projekt ist „EX“, dann suche ich das unterste „EX“ in der Liste, gehe eine Zeile runter, bin also in „FX“.
Dann prüfe ich „EX“ ab, ist die zeile danach leer lösche ich die komplette Zeile.

D,h. oberhalb meines Standpunktes (FX) habe ich nun entweder „DX“ oder den untersten Eintrag von „EX“, wobei im Falle von „EX“ die Zeile dahinter nicht leer ist.

Füge ich nun eine Zeile ein so erscheint sie oberhalb des Standpunktes also oberhalb von „FX“, in der neuen Zeile füge ich dann vorne „EX“ ein, danach die gewünschten anderen Zellwerte"

Ich kann ja Code nur für mir bekannte Datistrukturen entwickeln, in meiner Beispieldatei klappt er ja auch.

Logisch macht er Probleme wenn man ihn 1:1 in andere Tabellenstrukturen einsetzen will.

Deshalb meine Nachfrage nach Beispielmappe deinerseits die die exakten Tabellenstrukturen hat wie deine Originaltabellen.

Gruß
Reinhard

Anna4621 · 10. November 2019 um 12:25

Hallo Reinhard,

hier meine Beispiel Dateien!Hab hier drin auch den Code von Dir!Da sieht man dass das Projekt gelöscht wird, aber nichts eingetragen wird!
Vielen lieben Dank für deine Hilfe!

Liebe Grüsse Anna

http://www.hostarea.de/server-08/August-6c2c6c3f3d.xls
http://www.hostarea.de/server-08/August-4ddeebc027.xls

Anna4621 · 10. November 2019 um 12:27

Antwort Artikel steht zwei Zeilen weiter unten!

Reinhard_fb8cb7 · 10. November 2019 um 12:27

Antwort Artikel steht zwei Zeilen weiter unten!

Hi Anna,

so funktioniert der Code, bezogen auf die beiden Dateien die du hochgeladen hast.

Sub tt()
Dim Zei1 As Long, wks1 As Worksheet, Zei2 As Long, wks2 As Worksheet
Dim Awf As WorksheetFunction
Set Awf = Application.WorksheetFunction
Set wks1 = Workbooks("August-6c2c6c3f3d.xls").Worksheets("Tabelle1")
Set wks2 = Workbooks("August-4ddeebc027.xls").Worksheets("Tabelle1")
With wks1
 If Awf.CountIf(wks2.Columns(1), .Range("I66")) \> 0 Then
 Zei2 = Awf.Match(.Range("I66"), wks2.Columns(1), 0)
 While wks2.Cells(Zei2 + 1, 1) = .Range("I66")
 Zei2 = Zei2 + 1
 Wend
 If wks2.Cells(Zei2, Columns.Count).End(xlToLeft).Column = 1 Then
 wks2.Rows(Zei2).Delete
 Else
 Zei2 = Zei2 + 1
 End If
 For Zei1 = 1 To .Range("B" & Rows.Count).End(xlUp).Row
 If .Cells(Zei1, 6) = "(+)" Then
 wks2.Rows(Zei2).Insert
 wks2.Cells(Zei2, 1) = .Range("I66")
 wks2.Cells(Zei2, 3) = .Cells(Zei1, 2) 'b-\>C
 wks2.Cells(Zei2, 4) = .Cells(Zei1, 3) 'c-\>d
 wks2.Cells(Zei2, 5) = .Cells(Zei1, 6) 'f-\>e
 wks2.Cells(Zei2, 6) = .Cells(Zei1, 10) 'j-\>F
 wks2.Cells(Zei2, 7) = .Cells(Zei1, 5) 'e-\>g
 Zei2 = Zei2 + 1
 End If
 Next Zei1
 Else
 MsgBox "Projekt " & .Range("I66") & " nicht gefunden."
 End If
End With
End Sub

Gruß
Reinhard