Mit VB Script bzw. Makro Tabellenreihen kopieren

Schon mal vielen Dank im Voraus!

[Edit Biber] Ist doch ganz banal mit SVerweis() lösbar -- also verschoben von "Visual Basic, VBA und .Net" nach "Excel" [Edit]

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 110478

Url: https://administrator.de/forum/mit-vb-script-bzw-makro-tabellenreihen-kopieren-110478.html

Ausgedruckt am: 23.12.2024 um 00:12 Uhr

11 Kommentare

Neuester Kommentar

Hallo Sebastian

Ist vielleicht eine etwas naive Frage...aber wieso machst Du es nicht einfach mit einem SVERWEIS?

Gruss
Rubberduck

Hallo Rubberduck,

ganz einfach, weil die Zahlen auf Blatt2 immer random-generiert werden.. und da ist es etwas umständlich, jedes mal einen Zellenverweis einzustellen.

Könntest Du das .xls mal raufstellen?
Ich möchte zwar nichts behaupten, aber ich denke, dass es gehen sollte...

Das kann ich aus Datenschutzgründen leider nicht tun.

...

Ich hoffe, dass das nur ein witz war...

Kannst ja die besonders schützenswerte Daten rausnehmen.
Und ob dort jetzt "blabla" oder "labla" drinsteht, tut glaub ich nichts zur Sache.

Die Adressen aus Blatt1 sollten lückenlos ab Zeile x untereinander stehen. Wenn dem so ist einfach mit einer for next Schleife suche ab zeile x nachfolgend nach z.B. >0 dann Zeilenummer merken, adressdaten merken (Merken=in Variablen einlesen). Die Variablen als Public deklarieren.
Dann in Blatt2 nach Vorhandensein der Adressnummer suchen, wenn gefunden die Daten aus den Variablen in die entsprechenden Felder schreiben. Wenn nicht vorhanden next.
Sind die Blätter in verschiedenen Arbeitsmappen oder in der selben Mappe????

So könntest Du die Anzahl der Adressen ermitteln, sucht in Spalte A ab Zeile A4 nach einer Leerzelle:

Columns("A").Find("", After:=[A3]).Select
AdressAnzahl = Selection.Row - 4

So könnte es funktionieren, Annahme es sind 2 Arbeitsmappen und die Daten sind ab Zeile 4/SpalteA..., ggfs. die Mappen-/Blatt Namen anpassen:

Public NameTxt
Public AdresseTxt
Public TelefonTxt
Public AdressNr
Public AdressAnzahl

Sub Adressen_Uebertragen()

Application.Workbooks("Mappe1_Adressen.XLS").Activate
Application.Sheets("Tabelle1").Activate

Columns("A").Find("", After:=[A3]).Select
AdressAnzahl = Selection.Row - 4

For i = 1 To AdressAnzahl
NameTxt = ""
AdresseTxt = ""
TelefonTxt = ""

Application.Workbooks("Mappe1_Adressen.XLS").Activate
Application.Sheets("Tabelle1").Activate

AdressNr = ActiveSheet.Cells(i + 3, 1).Value
NameTxt = ActiveSheet.Cells(i + 3, 2).Value
AdresseTxt = ActiveSheet.Cells(i + 3, 3).Value
TelefonTxt = ActiveSheet.Cells(i + 3, 4).Value

'Blatt2 muss jetzt aktiviert werden....

Application.Workbooks("Mappe2_Adressen_Kopiert.XLS").Activate
Application.Sheets("Tabelle1").Activate
For k = 1 To AdressAnzahl
If ActiveSheet.Cells(k + 3, 1).Value = AdressNr Then
ActiveSheet.Cells(k + 3, 2).Value = NameTxt
ActiveSheet.Cells(k + 3, 3).Value = AdresseTxt
ActiveSheet.Cells(k + 3, 4).Value = TelefonTxt
GoTo Naechste_Adresse
End If
Next 'k
Naechste_Adresse:
Next 'i

End Sub

Das ganze ist natürlich ohne Fehlerprozedur. Die beiden Mappen müssen geöffnet sein.

Gruß OpTiMaX

bin immer noch überzeugt, dass es ohne VBA geht.
rein nur mit formeln...

Hallo OpTiMaX, danke für deinen Ansatz. Die Worksheets sind alle in der selben Arbeitsmappe.

Ich habe schon einen Ansatz hinbekommen:

Sub Zeilen_kopieren()
Dim a As Long, i As Long
Application.ScreenUpdating = False
a = 1
For i = 1 To 29
If Worksheets("CE").Cells(i, "A") = Worksheets("Tabelle1").Cells(i, "A") Then
Worksheets("CE").Rows(i).Copy _
Destination:=Worksheets("Tabelle1").Rows(i)
a = a + 1
End If
Next i
Application.ScreenUpdating = True

End Sub

Allerdings kopiert er mir hier nur die Zeilen, in denen die Nummer von Blatt1 mit der Nummer auf Blatt2 übereinstimmt. Also zum Beispiel:

Auf Blatt1 steht in Zelle A23 die Zahl 22.
Durch den Zufallsgenerator wurde auf Blatt2 in Zelle A23 ebenfalls die Zahl 22 generiert -> Zeile von Zelle A23 wird von Blatt1 korrekt auf Blatt2 kopiert.

Alle anderen Zeilen (z.B. Blatt1 A14 = 13; Blatt2 A14 = 25) werden nicht kopiert.

Es soll einfach so sein, dass er sich von Blatt2 die Zelle A1 nimmt (z.B. Wert 42), dann in Blatt1 springt und die Zeile kopiert, in der A=42 ist.
Das gleiche dann für A2 auf Blatt2 (z.B. Wert 13), dann in Blatt1 springen und Zeile kopieren, in der A=13 ist. usw.

Dann brauchst Du die Mappe nicht zu wechseln.

Public NameTxt
Public AdresseTxt
Public TelefonTxt
Public AdressNr
Public AdressAnzahl

Sub Adressen_Uebertragen()

Application.Sheets("Blatt1").Activate

Columns("A").Find("", After:=[A3]).Select
AdressAnzahl = Selection.Row - 4

For i = 1 To AdressAnzahl
NameTxt = ""
AdresseTxt = ""
TelefonTxt = ""

Application.Sheets("Blatt1").Activate

' Beschreibung... ActiveSheet.Cells(ZeileNummer,SpalteNummer)
AdressNr = ActiveSheet.Cells(i + 3, 1).Value
NameTxt = ActiveSheet.Cells(i + 3, 2).Value
AdresseTxt = ActiveSheet.Cells(i + 3, 3).Value
TelefonTxt = ActiveSheet.Cells(i + 3, 4).Value

'Blatt2 muss jetzt aktiviert werden....

Application.Sheets("Blatt2").Activate

For k = 1 To AdressAnzahl
If ActiveSheet.Cells(k + 3, 1).Value = AdressNr Then
ActiveSheet.Cells(k + 3, 2).Value = NameTxt
ActiveSheet.Cells(k + 3, 3).Value = AdresseTxt
ActiveSheet.Cells(k + 3, 4).Value = TelefonTxt
GoTo Naechste_Adresse
End If
Next 'k
Naechste_Adresse:
Next 'i

End Sub