Label füllen

Hallo zusammen,
Bitte um VBA Hilfe!
Wie kann ich in meiner Arbeitsmappe bestehend aus den Blättern Daten und Label,
die Zelleinhalte aus Blatt Daten von den Spalten B, C und E der momentan aktiven Zeile
via Doppelklick in das Blatt Label in die Zellen B1, C3 und C4 übernehmen?
Folgende Bedingungen müssen erfüllt werden:
Wenn im Blatt Label die Zellen B1, C3 und C4 bereits Informationen enthalten dann
sollten die Zellinhalte in B6,C7 und C8 übernommen werden. Sind diese ebenfalls
bereits mit Informationen belegt dann Übernahme in die Zellen B10, C11 und C12.
Sind auch diese belegt dann Übernahme in B14, C15 und C16.
Sollten auch diese belegt sein! Dann sollte Auswahlfeld erscheinen wie z.B.
Labelfelder belegt alle löschen Ja/Nein!
wenn Ja dann oben genannte Felder leeren und Übernahme in die Zellen B1, C3 und C4!
usw.
Vielen Dank für Eure Hilfe
Gruß Gerhard

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Gerhard,
wegen der nicht-gleichmäßigen Anordnung Deiner Label-Positionen etwas mühsam, aber es geht. Hier ist der Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Daten(3) As String, _
Labelfeld(4, 3) As Range, _
i As Long, _
j As Long, _
LabelNummer As Long
'Labelfelder definieren
With Sheets("Label")
Set Labelfeld(1, 1) = .Range("B1")
Set Labelfeld(1, 2) = .Range("C3")
Set Labelfeld(1, 3) = .Range("C4")
Set Labelfeld(2, 1) = .Range("B6")
Set Labelfeld(2, 2) = .Range("C7")
Set Labelfeld(2, 3) = .Range("C8")
Set Labelfeld(3, 1) = .Range("B10")
Set Labelfeld(3, 2) = .Range("C11")
Set Labelfeld(3, 3) = .Range("C12")
Set Labelfeld(4, 1) = .Range("B14")
Set Labelfeld(4, 2) = .Range("C15")
Set Labelfeld(4, 3) = .Range("C16")
End With
'Ziel finden
LabelNummer = 0
For i = 1 To 4
If Labelfeld(i, 1) = "" Then
LabelNummer = i
Exit For
End If
Next i
'Wenn kein Ziel gefunden, fragen
If LabelNummer = 0 Then
i = MsgBox("Alle Labels belegt. Löschen und neu?", vbYesNo, "Achtung!")
If i = 6 Then
'Wenn's neu soll, erst Labelfelder löschen ...
For i = 1 To 4
For j = 1 To 3
Labelfeld(i, j).ClearContents
Next j
Next i
'... und Label 1 vorgeben
LabelNummer = 1
End If
End If
'sofern es neu soll, jetzt die Daten kopieren
If LabelNummer  0 Then
Labelfeld(LabelNummer, 1) = Cells(Target.Row, 2)
Labelfeld(LabelNummer, 2) = Cells(Target.Row, 3)
Labelfeld(LabelNummer, 3) = Cells(Target.Row, 5)
End If
'Zellbearbeitung verlassen
Target.Offset(0, 1).Select
End Sub

Fertig eingearbeitet findest Du ihn in dieser Mappe: https://www.herber.de/bbs/user/63156.xls im Code der Tabelle "Daten".
Kommst Du zurecht?
Gruß, Wolfgang

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Label füllen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread