Zelle voll? Go to next cell

Hallo zusammen,
ich würde gerne in Zelle A1/A2 sowie B1/B2 Daten eingeben und per VBA-Button in eine Tabelle kopieren. Der Zelleninhalt von A1/A2 soll in die Tabelle in Zelle D1/D2 kopiert werden, Zelle B1/B2 entsprechend in E1/E2. Zwei Dinge sind wichtig:
1. Sollten bereits Daten in Zelle D1/D2 bzw. E1/E2 kopiert worden sein, sollen die nächsten Daten rechts nebenstehend ab Zelle F1/F2 und G1/G2 kopiert werden.
2. Sollte bereits der Inhalt A1 = D1 oder F1 oder H1 oder J1 (also immer im Zweierschritt) stehen, soll ein Warnhinweis kommen und das kopieren verhindert werden.
Geht so etwas mit VBA? Leider bin ich nicht so erfahren, mit dem VBA-Recorder klappt es natürlich mit dem kopieren und einfügen, die zwei Bedingungen bekomme ich jedoch leider nicht hin ...
Über Eure Hilfe wäre ich super dankbar!
Viele Grüße
Thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Kopieren() If Range("X8") = "" Then Range("I9").Select Selection.Copy Range("X8").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("L8:M18").Select Application.CutCopyMode = False Selection.Copy Range("X9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("X10:Y19").Select Application.CutCopyMode = False Range("V7:V19").Select Selection.Copy Range("X7:Y19").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("L9").Select Else If Range("Z8") = "" Then Range("I9").Select Selection.Copy Range("Z8").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("L8:M18").Select Application.CutCopyMode = False Selection.Copy Range("Z9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("X10:AA19").Select Application.CutCopyMode = False Range("V7:V19").Select Selection.Copy Range("Z7:AA19").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("L9").Select End If End If End Sub

Moin!
Erstmal:
Aus aufgezeichneten Makros kann man immer jede Menge überflüssige Anweisungen rausschmeissen. Damit wird das ganze viel übersichtlicher.
Aus

Range("I9").Select
Selection.Copy
Range("X8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

wird

Range("I9").Copy
Range("X8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Und diese Anweisung wird verkürzt auf

Range("I9").Copy Range("X8")

Insgesamt sieht es dann so aus:

Sub Kopieren()
If Range("X8") = "" Then
Range("I9").Copy Range("X8")
Range("L8:M18").Copy Range("X9")
Range("V7:V19").Copy Range("X7")
Application.CutCopyMode = False
ElseIf Range("Z8") = "" Then
Range("I9").Copy Range("Z8")
Range("L8:M18").Copy Range("Z9")
Range("V7:V19").Copy Range("Z7")
Application.CutCopyMode = False
End If
End Sub

Aber als Schleife hab ich es mal so aufgebaut. Dabei bin ich davon ausgegangen, dass Quell-Sheet und Ziel-Sheet unterschiedlich sind. Ansonsten mußt du die Bezüge ändern.
Beachte, dass die Schleife alle Einträge in Zeile 1 durchläuft!


Sub Kopieren2()
Dim rng As Range
Set rng = Range("1:1").SpecialCells(xlCellTypeConstants)  'Zellen wähln mit Werten,
For Each cl In rng 'Schleife
Set ziel = Sheets("Tabelle2").Cells(1, Columns.Count).End(xlToLeft) 'letzte belegte  _
spalte suchen
ziel_sp = WorksheetFunction.Max(ziel.Column, 3) + 1 'Mindestens spalte "D"
Sheets("Tabelle2").Cells(1, ziel_sp).Value = cl.Value
Sheets("Tabelle2").Cells(2, ziel_sp).Value = cl.Offset(1, 0).Value
Next
End Sub

Probier´s mal aus
Gruß, MCO

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

39 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zelle voll? Go to next cell

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

39 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread