Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - Kopieren von Tabellenblatt 1 zu BLatt 2

VBA - Kopieren von Tabellenblatt 1 zu BLatt 2
09.02.2016 09:23:05
Tabellenblatt
Hallo und guten Morgen,
Vielleicht kennt einer von euch eine Lösung.
Ich muss ein Vorgang automatisieren - also eigentlich ist es nur eine Copy Funktion :-)
Bevor ich das lange erkläre habe ich die Excel hochgeladen.
Da ist es einfach erklärt und verständlich.
https://www.herber.de/bbs/user/103385.xlsx
WER KANN SOWAS?
:-) Vielen Dank im Voraus, euer Klotz am Bein.

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Kopieren von Tabellenblatt 1 zu BLatt 2
09.02.2016 13:23:58
Tabellenblatt
hallo
mit VBA kopieren ist kein Problem, ich habe die Aufgabe noch nicht ganz verstanden.
Es soll im grauen Bereich (bei mir grün/gelb) die Spalten L-O auf 1 geprüpft werden.
Dann müsste geprüft werden ob in der Spalte C ein Wert steht. Wenn ja, dann kopieren.
Das kopieren soll im Blatt2 in A1 erfolgen. D.h. die alte Zeile A1 muss vorher nach
unten verschoben werden, damit ein neuer Wert eingefügt werden kann. Die alten
Werte in Blatt2 sollen demnach nicht überschrieben werden!
Habe ich das so richtig verstanden?
mfg Piet

VBA - Kopieren von Tabellenblatt 1 zu BLatt 2
09.02.2016 16:13:21
Tabellenblatt
Hi Piet...
du hast alles richtig verstanden.
Auf Blatt 2 sieht man halt das Optimale Ergebnis.
Normalerweise wäre in jedem Feld über dem X irgend ein Eintrag.
Also X wäre in jedem Fall das erste unbeschriebene Feld in Blatt 2.
Also auf A:1 - A:16 im Blatt 2 stehen noch Werte.
:-) Vielen Dank im Voraus, dein Klotz am Bein.

Anzeige
VBA - Kopieren von Tabellenblatt 1 zu BLatt 2
09.02.2016 16:17:08
Tabellenblatt
Hi Piet nochmal - ich habe die Beispielexcel optimiert.
https://www.herber.de/bbs/user/103408.xlsx
So sollte auf Blatt 2 das Ergebnis aussehen :-)
Boing!

AW: VBA - Kopieren von Tabellenblatt 1 zu BLatt 2
09.02.2016 22:45:35
Tabellenblatt
Hallo erst mal ...
anbei 3 Makros als Lösung für diese Aufgabe. Warum drei ..?
Ich mache nicht gerne halbe Sachen, denke lieber Praxisgerecht!
Das 1. Makro ist die Grundlösung zum kopieren, sie ist aber nicht Praxisgerecht!
Als grundlegende Funktion taucht es in den beiden anderen Makros wieder auf.
Der Kopiervorgang in Makro1 laeuft als Demo über Range(SuchBer) "L6:L9". Dieser Bereich verschiebt
sich ja in der Praxis staendig nach unten. Es ist unsinnig den Bereich jedesmal von Hand festzulegen.
Die Kopier Funktion ist okay, aber für die taegliche Praxis so nicht brauchbar.
Bedingung: keine doppelten ID Nummern
Makro 2 ist m.E. die beste Lösung, setzt aber voraus das die ID Nummern nicht doppelt sind!
Hier suche ich zuerst in Blatt2 ab wo die aktuelle ID Nummer fehlt. Das ist die Start-Adresse
Alternativ: Spalte P als Hilfsspalte
Makro 3 benutzt P als Hilfsspalte und erwartet ein Zeichen ab wo der Start beginnen soll.
Für die End-Adresse benutze ich den letzten Eintrag in Spalte C.
Somit gibt es zwei Möglichkeiten für die Praktische Anwendung.
Würde mich freuen wenn das Programm zufriedenstellend laeuft.
PS ich weiss nicht ob es erforderlich ist noch eine Prüfung zu machen das keine Werte doppelt
übertragen werden. War hier nicht gefordert.
mfg Piet
Option Explicit '9.2.2016 Piet für Herber Forum
Const SuchBer = "L6:L9"
Dim Adr As String, Spa
Dim Edr As String, Zei
'Copy Grundmodul über Range(SuchBer)
Sub Blatt1_nach_Blatt2_kopieren()
'1. Schleife für suche in Spalte L
For Each Spa In Sheets("Blatt 1").Range(SuchBer)
'2. Schleife für Zelle 1-4 (rechts)
For Zei = 1 To 4
If Spa.Cells(1, Zei) = 1 Then
'Wenn L=1 ist ID Nummer vorhanden?
If Cells(Spa.Row, "C")  Empty Then
'Copy Anf- und End Adresse festlegen
Adr = Cells(Spa.Row, "A").Address
Edr = Cells(Spa.Row, "O").Address
'In Blatt2 eine Zeile einfügen und nach unten schieben
Sheets("Blatt 2").Rows("1:1").Insert Shift:=xlDown
'Blatt1: Spalte A-O kopieren, nur Werte einfügen
Sheets("Blatt 1").Range(Adr, Edr).Copy
Sheets("Blatt 2").Range("A1").PasteSpecial xlValues
Application.CutCopyMode = False  'CopyMode Aus
End If
End If
Next Zei
Next Spa
End Sub

Option Explicit '9.2.2016 Piet für Herber Forum
Dim SAdr As String, SEdr As String
Dim Adr As String, Spa, z
Dim Edr As String, Zei, ID
'Bedingung: -keine doppelte IDs- !!
'sucht in Blatt2 nach ID Nummer bis
'die 1. -fehlende ID- gefunden wird
Sub Blatt1_kopieren_überID_Suchlauf()
Dim rFind As Object, B2 As Object
Set B2 = Sheets("Blatt 2")
z = Cells.Rows.Count  'End Zelle "C"
'SEdr zuerst für Spalte C festlegen
SEdr = Range("C" & z).End(xlUp).Address
'Suchschleife für alle vorhandenen IDs in Blatt 2
'Ende wenn ID in Blatt2 -nicht gefunden wird-
For Each ID In Sheets("Blatt 1").Range("C1", SEdr)
Set rFind = Sheets("Blatt 2").Columns(3) _
.Find(What:=ID, After:=B2.[c1], LookIn:=xlFormulas, LookAt:=xlWhole)
If rFind Is Nothing Then Exit For
Next ID
'SAdr + SEdr für Spalte L festlegen
SAdr = Range(ID.Address).Cells(1, 10).Address
SEdr = Range(SEdr).Cells(1, 10).Address
'1. Schleife für suche in Spalte L
For Each Spa In Sheets("Blatt 1").Range(SAdr, SEdr)
'2. Schleife für Zelle 1-4 (rechts)
For Zei = 1 To 4
If Spa.Cells(1, Zei) = 1 Then
'Wenn L=1 ist ID Nummer vorhanden?
If Cells(Spa.Row, "C")  Empty Then
'Copy Anf- und End Adresse festlegen
Adr = Cells(Spa.Row, "A").Address
Edr = Cells(Spa.Row, "O").Address
'In Blatt2 eine Zeile einfügen und nach unten schieben
Sheets("Blatt 2").Rows("1:1").Insert Shift:=xlDown
'Blatt1: Spalte A-O kopieren, nur Werte einfügen
Sheets("Blatt 1").Range(Adr, Edr).Copy
Sheets("Blatt 2").Range("A1").PasteSpecial xlValues
Application.CutCopyMode = False  'CopyMode Aus
End If
End If
Next Zei
Next Spa
End Sub

Option Explicit '9.2.2016 Piet für Herber Forum
Dim SAdr As String, SEdr As String
Dim Adr As String, Spa, z
Dim Edr As String, Zei
'Hilfsspalte P 1.Wert für Programm Start
'Spalte C letzte Zelle für Programm Ende
'Start Zeichen wird am Ende gelöscht!!
Sub Blatt1_kopieren_Hilfsspalte_P()
'sucht in Spalte P 1.Wert und in C letzten Wert
z = Cells.Rows.Count  'End Zelle oder Zahl angeben
SAdr = Range("P1").End(xlDown).Cells(1, -3).Address
SEdr = Range("C" & z).End(xlUp).Cells(1, 10).Address
'1. Schleife für suche in Spalte L
For Each Spa In Sheets("Blatt 1").Range(SAdr, SEdr)
'2. Schleife für Zelle 1-4 (rechts)
For Zei = 1 To 4
If Spa.Cells(1, Zei) = 1 Then
'Wenn L=1 ist ID Nummer vorhanden?
If Cells(Spa.Row, "C")  Empty Then
'Copy Anf- und End Adresse festlegen
Adr = Cells(Spa.Row, "A").Address
Edr = Cells(Spa.Row, "O").Address
'In Blatt2 eine Zeile einfügen und nach unten schieben
Sheets("Blatt 2").Rows("1:1").Insert Shift:=xlDown
'Blatt1: Spalte A-O kopieren, nur Werte einfügen
Sheets("Blatt 1").Range(Adr, Edr).Copy
Sheets("Blatt 2").Range("A1").PasteSpecial xlValues
Application.CutCopyMode = False  'CopyMode Aus
End If
End If
Next Zei
Next Spa
'Spalte P Start Zeichen löschen
Range(SAdr).Cells(1, 5) = Empty
End Sub

Anzeige
AW: VBA - Kopieren von Tabellenblatt 1 zu BLatt 2
10.02.2016 11:08:11
Tabellenblatt
Hey Piet,
Danke für deine Arbeit.
Das sieht auch sehr gut aus.
Variante 2 gefällt mir am besten.
Kann ich dir die Original Excel mal per Mail zuschicken?
Ich möchte die aber nicht veröffentlichen.
LG

Push
10.02.2016 12:55:45
Piet
Ungelöst

AW: Push
10.02.2016 23:26:09
Piet
hallo
habe jetzt erst wieder ins Forum geschaut, war beschaeftigt.
Als Piet der Grosse fühle ich mich nicht, zu den echten Profis gehöre ich nicht.
Die erkennen an der Programmier Art und Befehlen sofort wer ein echter Profi ist.
Aber vielen Danke für die Blumen.
Ich las aber das Wort ungelöst. Gibt es noch ungelöste Probleme?
mfg Piet
Anzeige

8 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige