kopieren von Tb zu Tb mit klick in Zelle

Hallo Forum
Stricke mir gerade eine Busticketbestellung zusammen, die auch (Dank Eurer Hilfe)
fast fertig ist. Jetzt hat sich allerdings noch ein Problem ergeben. Zu den normalen Tarifgebieten, das mache ich mit (SVerweis) müssen jetzt noch Unterwaben ausgewählt werden. Da für weitere Auswahlfelder im Formular kein Platz mehr ist, möchte ich gerne das aus der Tabelle Unterwaben, in die Zelle geklickt werden kann, oder daneben, und der Wert aus Wabe in das erste Feld von Tarifgebiet A1 (Zusatzwaben) falls dort schon was drin steht in das zweite Zusatzfeld der Tabelle Bestellung kopiert wird. Das gleiche für das Tarifgebiet A2. Ich hoffe das war jetzt nicht zu kompliziert erklärt, ich lade mal einen kleinen Nachbau hoch. Ich hoffe das dies machbar ist und sage schon mal Danke für Eure Hilfe.
Gruß, Guesa
https://www.herber.de/bbs/user/111167.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Guesa,
Das ist einfach nur genial, mit sowas komplexes hab ich nicht gerechnet.

Die komplexität kommt
1. Durch die Prüfungen um sicherzustellen, dass die angeklickte Zelle eine Eingabezelle für eine Zusatzwabe ist.
2. Durch den eingebauten Komfort, dass im Blatt "Unterwaben" zu den Zeilen mit dem Tarifgebiet gescrollt wird.
Ob dein vorhandenens Worksheet_BeforeDoubleClick-Makro ohne Probleme mit meinem zusammengefasst werden kann, kann ich so nicht sagen.
Baue die Anweisungen meines Makros mal vor deinen vorhandenen ein.
Dann sollte es eigentlich funktionieren.
Für den Transport von Makros zwischen Computern sind übrigens einfache Text-Programme wie Notepad am besten geeignet. Es muss nicht unbedingt Word sein.
LG
Franz

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Zeile As Long, Spalte As Long, ZeileU As Long
Dim bolAuswahl As Boolean
Dim strTarifGebiet As String
Dim objWSH As Object, intMSG As Integer
Zeile = Target.Row
bolAuswahl = True
If Left(Trim(Cells(Zeile, 1).Text), 11) = "Zusatzwaben" Then
Select Case Target.Column
Case 2, 5 'Spalte B oder E
Spalte = Target.Column
If Not IsEmpty(Target.Range("A1")) Then
If MsgBox("In der aktiven Zelle ist bereits eine Unterwabe eingetragen." _
& vbLf & "Auswahl ändern?", _
vbYesNo, "Auswahl Unterwabe " & Cells(Zeile - 4, 2).Text) = vbNo Then
bolAuswahl = False
End If
End If
If bolAuswahl = True Then
'Tarifgebiet ermitteln
strTarifGebiet = Trim(Cells(Zeile - 3, 2).Text)
strTarifGebiet = Left(strTarifGebiet, InStr(strTarifGebiet, " ") - 1)
With ThisWorkbook.Worksheets("Unterwaben")
.Select
'Zeile mit Tarifgebiet suchen
For ZeileU = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(ZeileU, 1).Value = strTarifGebiet Then
ActiveWindow.ScrollRow = ZeileU
.Cells(ZeileU + 1, 3).Select
End If
Next
End With
'Meldung für ca. 1 Sekunde anzeigen
Set objWSH = CreateObject("WScript.Shell")
intMSG = objWSH.Popup("Bitte per Rechte-Maustasten-Klick gewünschte " _
& "Wabe auswählen" & vbLf _
& "(Meldung wird nach ca. 1 Sekunde wieder ausgeblendet)", _
1, "Auswahl Unterwabe " & Cells(Zeile - 4, 2).Text)
Set objWSH = Nothing
End If
End Select
End If
'ab hier dann dein Code aus Worksheet_BeforeDoubleClick-Makro
End Sub

Beliebteste Forumthreads (12 Monate)

kopieren von Tb zu Tb mit klick in Zelle

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

kopieren von Tb zu Tb mit klick in Zelle

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

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread