Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
820to824
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
820to824
820to824
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten von A nach B kopieren

Daten von A nach B kopieren
21.11.2006 01:14:47
A
Hi Excel Cracks,
steh grad auf den Schlauch. Dürfte eigentlich kein großes Problem sein...:)
Habe hier ein Skript, welches mir gleiche Daten von einer Haupttabelle in einzelne Tabellen kopiert.
Beispiel:
Hauptabelle (Spalte1/Zeile1,2,3,4...): Meier, König, Meier, Schuster...
Diesen Namen können auch mehrfach vorkommen und dieser Block von z. B. allen "Meier" soll dann auf das entsprechende Tabelleblatt "Meier" kopiert werden.
Das klappt soweit auch alles prima!
Mein Problem ist, dass die Daten fortlaufend auf die jeweiligen Tabellen
kopiert werden. Mein Wunsch ist es, dass die Daten immer in Zeile 7 bei dem jeweiligen Blatt eingefügt werden.
Ich hab zum näheren Verständnis mal eine Beispieldatei hochgeladen:
https://www.herber.de/bbs/user/38351.xls
Hier schon einmal das Skript:
Option Explicit

Sub VonGesamtNachEinzelnKopieren()
'Initialisieren der Variablen
Dim I&, J&, LZ1&, LS1&, LZ2&, LS2&, a&, x&
Dim Ws1 As Worksheet
Set Ws1 = Sheets(1) 'Haupttabelle
LZ1 = GetLastRow(Ws1) 'Letzte Zelle mit Daten ermitteln
LS1 = GetLastCol(Ws1) ' Letzte Spalte mit Daten ermitteln
I = 1 ' Zellen, die durchsucht werden sollen
x = 7 'Einfügezelle
Do While I < LZ1
I = I + 1 'Zähler zum Vergleichen der Daten in der Haupttabelle
For J = 1 To LS1
For a = 2 To Sheets.Count - 1
If Ws1.Cells(I, 1) = Sheets(a).Range("A1") Then
'vergleicht den Wert auf jeden einzelnen Tabellenblatt, mit den Werten aus der Haupttabelle
Sheets(a).Cells(x, J) = Ws1.Cells(I, J) 'Gleiche Daten von Gesamt nach Einzeln kopieren
End If
Next a
Next
x = x + 1
Loop
Set Ws1 = Nothing
'Es fehlt: Wie setzt man den Zähler x wieder auf 0 bzw., dass die Einfügezeile auf jeden Tabellenblatt "Zeile 7" ist?!?!?
End Sub


Function GetLastRow(Ws As Worksheet) As Long
GetLastRow = Ws.Range("A65536").End(xlUp).Row
End Function


Function GetLastCol(Ws As Worksheet) As Long
GetLastCol = Ws.Cells(1, Columns.Count).End(xlToLeft).Column
End Function


Sub NamenFürEinzelneBlätterAnlegen()
Dim I As Integer
For I = 2 To Sheets.Count - 1
Sheets(I).Range("A1") = Sheets(I).Name
Next I
End Sub

Wäre nett, wenn mir jemand helfen könnte.
Gruß doey

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten von A nach B kopieren
21.11.2006 01:58:39
A
Hallo doey,
Versuch es mal so :
Option Explicit

Sub VonGesamtNachEinzelnKopieren()
'Initialisieren der Variablen
Dim I&, J&, LZ1&, LS1&, LZ2&, LS2&, a&, x&
Dim Ws1 As Worksheet
Set Ws1 = Sheets(1) 'Haupttabelle
LZ1 = GetLastRow(Ws1) 'Letzte Zelle mit Daten ermitteln
LS1 = GetLastCol(Ws1) ' Letzte Spalte mit Daten ermitteln
I = 1 ' Zellen, die durchsucht werden sollen
x = 7 'Einfügezelle
Do While I < LZ1
I = I + 1 'Zähler zum Vergleichen der Daten in der Haupttabelle
For J = 1 To LS1
For a = 2 To Sheets.Count
If Ws1.Cells(I, 1) = Sheets(a).Range("A1") Then
'vergleicht den Wert auf jeden einzelnen Tabellenblatt, mit den Werten aus der Haupttabelle
If Sheets(a).Cells(65536, J).End(xlUp).Offset(1, 0).Row < 7 Then x = 7
Sheets(a).Cells(x, J) = Ws1.Cells(I, J) 'Gleiche Daten von Gesamt nach Einzeln kopieren
End If
Next a
Next
x = x + 1
Loop
Set Ws1 = Nothing
'Es fehlt: Wie setzt man den Zähler x wieder auf 0 bzw., dass die Einfügezeile auf jeden Tabellenblatt "Zeile 7" ist?!?!?
End Sub

Rückmeldung obs hilft wäre nett.
Viele Grüße aus Köln.
Anzeige
AW: Daten von A nach B kopieren
21.11.2006 05:31:41
A
Hi Mustafa,
vielen Dank für die rasche Beantwortung meiner Frage.
Die Skriptzeile von Dir, ist genau das was ich gesucht habe.
Jetzt hat sich aus diesem Skript-Zusatz ein neues Problem ergeben:
Wenn ich in eine neue Spalte Daten eingebe, muss der Eintrag immer in der ersten Zeile
des neuen Namens stehen, sonst kopiert mir das Skript nicht alle Daten zu dieser Person
in das jeweilige Tabellenblatt.
Beispiel:
wird nicht alles kopiert
Spalte1 / Spalte2 / Spalte3
Meier / Hans / "ist leer, wird nicht kopiert"
Meier / Hans / Nürnberg
Meier / Hans / "ist leer, wird kopiert!"
____
wird alles kopiert
Spalte1 / Spalte2 / Spalte3
Meier / Hans / Nürnberg
Meier / Hans / "ist leer, wird kopiert!"
Meier / Hans / "ist leer, wird kopiert!"
Kannste auch testen, indem du deine Skriptzeile rausnimmst, dann kopierts alle Daten.
zu kompliziert erklärkt?!?
Hoffentlich kannst Du mir noch einmal zur Seite stehen :).
Danke nochmal.
Gruß doey
Gruß aus Nürnberg
Anzeige
AW: Daten von A nach B kopieren
21.11.2006 05:48:39
A
Hallo Doey,
dann ändere bitte mal die Zeile :
If Sheets(a).Cells(65536, J).End(xlUp).Offset(1, 0).Row &lt 7 Then x = 7
In :
If Sheets(a).Cells(65536, 1).End(xlUp).Offset(1, 0).Row &lt 7 Then x = 7
Rückmeldung obs hilft wäre nett.
Viele Grüße aus Köln.
AW: Daten von A nach B kopieren
21.11.2006 06:01:29
A
Hi Mustafa,
ich dank Dir!
Jetzt läufts einwandfrei.
Gute Nacht
doey

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige