Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA mehrere Zellen statt einer kopieren

VBA mehrere Zellen statt einer kopieren
14.07.2021 09:04:33
Lisa
Hallo zusammen,
ich habe eine VBA Frage, bei der ich nicht weiter komme.
Der Code geht die Zeile D durch, kopiert den Inhalt von Zelle D1, solange sie nicht leer ist und, fügt diesen in Blatt "1" in C3 ein, ruft ein anderes Makro auf und kopiert solange weiter, wie Spalte D ungleich leer.
Folgenden Code habe ich geschrieben:
Option Explicit

Sub Kopieren()
Dim lZeile_D  As Long
With ThisWorkbook.Worksheets("2")
For lZeile_D = 1 To 10000
If Trim(.Range("D" & lZeile_D).Value)  "" Then
.Range("D" & lZeile_D).Copy
Sheets("1").Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call Zeile_kopieren
End If
Next lZeile_D
End With
Application.CutCopyMode = False
End Sub
Mein Ziel ist es, dass der Code jedes Mal nicht nur Spalte D überprüft und rüber kopiert, sondern gleichzeitig auch A, B, C und D.
Die Werte sollen dann jedes Mal in Blatt "1" Zelle B3, C3, D3 und F3 abgelegt werden, das Makro Zeile_kopieren aufgerufen werden und ein neuer Durchgang gestartet werden. Eine kleine Schwierigkeit gibt es noch: Im ersten Durchgang soll das Makro Zeile_kopieren aufgerufen werden, bei allen weiteren Durchgängen Zeile_kopieren2. Das habe ich im obigen VBA Code rausgenommen, weil das überhaupt nicht mehr funktioniert hat.
Über Hilfe bin ich sehr dankbar, ich bekomme es einfach nicht hin, dies so umsetzten, wie ich es brauche. Zwar schaffe ich es alle Spalten durchzugehen und in die entsprechenden Zellen in Blatt "1" zu kopieren, dann wird jedoch das Makro Zeile_kopieren nicht mehr zum richtigen Zeitpunkt aufgerufen. Das Aufrufen von Zeile_kopieren2 bekomme ich auch mit einer Schleife nicht wirklich hin.
Liebe Grüße
Lisa

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA mehrere Zellen statt einer kopieren
14.07.2021 09:56:26
UweD
Hallo
so?

Option Explicit
Sub Kopieren()
Dim lZeile_D  As Long, LR As Long
Dim TB1 As Worksheet, TMP As Boolean
Set TB1 = Sheets("1")
With ThisWorkbook.Worksheets("2")
LR = .Cells(.Rows.Count, "D").End(xlUp).Row 'letzte Zeile der Spalte
For lZeile_D = 1 To LR
If Trim(.Range("A" & lZeile_D).Value)  "" And _
Trim(.Range("B" & lZeile_D).Value)  "" And _
Trim(.Range("C" & lZeile_D).Value)  "" And _
Trim(.Range("D" & lZeile_D).Value)  "" Then
TB1.Range("B3:D3").Value = .Range("A" & lZeile_D & ":C" & lZeile_D).Value
TB1.Range("F3").Value = .Range("D" & lZeile_D).Value
If Not TMP Then
Call Zeile_kopieren
TMP = True
Else
Call Zeile_kopieren2
End If
End If
Next lZeile_D
End With
Application.CutCopyMode = False
End Sub
Sub Zeile_kopieren()
MsgBox "'Zeile_kopieren'    ausgeführt"
'hier dein Makro
End Sub
Sub Zeile_kopieren2()
MsgBox "'Zeile_kopieren222222'    ausgeführt"
'hier dein Makro2
End Sub
LG UweD
Anzeige
AW: VBA mehrere Zellen statt einer kopieren
14.07.2021 10:23:08
Lisa
Hallo UweD,
Danke für den tollen Code, ich habe wieder was Neues gelernt:) Es funktioniert genauso, wie es soll!
Schönen Tage und viele Grüße
Lisa
Danke für die Rückmeldung (owT)
14.07.2021 10:49:30
UweD
AW: VBA mehrere Zellen statt einer kopieren
14.07.2021 10:10:02
Peter
Hallo Lisa,
mir ist dein Problem noch nicht ganz klar. Ich nehme Folgendes an:
- du willst nur die Zelle in Spalte D im Blatt 2 überprüfen und dann (bei nicht-leer) die Werte der Zellen aus Spalten A-D nach Blatt 1 kopieren.
- Willst du wirklich die Werte aus Spalten A-D nach Zellen B3-D3/F3 kopieren oder doch nach B3-E3?
- Darf man die Formatierungen aus Blatt 2 wirklich nicht mitkopieren? Sonst wäre Code einfacher!
Ich habe je beide Varianten im Code - das jeweils Falsche löschen!
Ich hoffe es funktioniert, hab's nicht überprüft...

Sub Kopieren()
Const lSpalte As Integer = 4 'Spalte D
Const lZeileVon As Long = 1
Const lZeileBis As Long = 10000
Dim lZeile As Long
ThisWorkbook.Worksheets("1").Activate 'Wir sind im Zielblatt (1)
With Worksheets("2")
For lZeile = lZeileVon To lZeileBis
If Not IsEmpty(.Cells(lZeile, lSpalte)) Then
'1. Bereich Ax-Dx aus Blatt2 nach B3-E3 in Blatt 1 (hierher) kopieren:
'a) wenn Formatierungen mitgenommen werden dürfen:
.Range(.Cells(lZeile, 1), .Cells(lZeile, 4)).Copy Destination:=Range("B3")
'b) wenn nicht:
.Range(.Cells(lZeile, 1), .Cells(lZeile, 4)).Copy
Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'2. Bereich Ax-Dx aus Blatt2 wirklich nach B3-D3 / F3 in Blatt 1 (hierher) kopieren:
'a) wenn Formatierungen mitgenommen werden dürfen:
.Range(.Cells(lZeile, 1), .Cells(lZeile, 3)).Copy Destination:=Range("B3")
Range("F3") = .Cells(lZeile, 4) 'einfacher...
'b) wenn nicht:
.Range(.Cells(lZeile, 1), .Cells(lZeile, 3)).Copy
Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F3") = .Cells(lZeile, 4) 'einfacher...
If lZeile = lZeileVon Then
Call Zeile_kopieren
Else
Call Zeile_kopieren2
End If
End If
Next lZeile
End With
Application.CutCopyMode = False
End Sub

Anzeige
AW: VBA mehrere Zellen statt einer kopieren
14.07.2021 10:28:31
Lisa
Hallo Peter,
auch Dir vielen Dank, ich teste später und gebe nochmal Rückmeldung, ob der Code soweit klappt:)
Die Formatierung durfte tatsächlich nicht beibehalten werden.
Schönen Tag und viele Grüße
Lisa

345 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige