Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1656to1660
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Text in die Zwischenablage kopieren wenn ...

VBA: Text in die Zwischenablage kopieren wenn ...
22.11.2018 14:19:55
Matthias
Hallo zusammen
In meiner Beispieldatei möchte ich gerne von UNTEN beginnend, immer vom letzten x (A13) bis zum nächsten letzten x (A10), Inhalte in die Zwischenablage kopieren, sofern in Spalte D ein ja aufgeführt ist. Der Absatz soll entweder mit einem PopUp gefragt werden, oder anhand der aktuellen Zellenmarkierung erkannt werden.
Das gäbe dann folgenden Inhalt in die Zwischenablage (am liebsten unformatiert) wenn eine Zelle von A10 bis D13 markiert wäre:
B10:C10
B12:C12
https://www.herber.de/bbs/user/125580.xlsx
Wäre grossartig wenn mir da jemand helfen könnte :-)
Liebe Grüsse
Matthias

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Text in die Zwischenablage kopieren wenn ...
22.11.2018 17:36:47
onur
"von UNTEN beginnend" wird nicht klappen.
AW: VBA: Text in die Zwischenablage kopieren wenn ...
22.11.2018 17:51:52
Herbert
Hallo Matthias,
"von unten beginnend" wird auch klappen! Kopiere den folgenden Code in den VBA-Bereich der "Tabelle1". Wenn du dann auf irgend eine Zelle in den Spalten von B - D klickst startet das Makro und übernimmt den gewünschten Inhalt in die ZA. Probiers mal!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sTextClipb$, sTextUp$, sTextDown$, oText As DataObject, iCountA%, iCountB%, iRowUp%,  _
iRowDown%
If Target.Column > 1 And Target.Column  "x" Then Exit For
If Cells(iCountA, 1) = "x" Then iRowUp = iCountA
Next iCountA
For iCountB = Target.Row To Target.Row + 10
If Cells(iCountB, 1)  "x" Then Exit For
If Cells(iCountB, 1) = "x" Then iRowDown = iCountB
Next iCountB
End If
sTextUp = "B" & iRowUp & ":C" & iRowUp
sTextDown = "B" & iRowDown & ":C" & iRowDown
sTextClipb = sTextUp & vbCrLf & sTextDown
oText.SetText sTextClipb
oText.PutInClipboard
Beep
End If
End Sub
Servus
Anzeige
AW: VBA: Text in die Zwischenablage kopieren wenn ...
23.11.2018 08:33:32
Matthias
Hey Herbert, das klingt ja grossartig. Vielen herzlichen Dank dass du dir Zeit genommen hast.
Es kommt allerdings eine Fehlermeldung:
"Fehler beim Kompilieren: Benutzerdefinierter Typ nicht definiert".
Und es markiert dabei den Text "oText As DataObject".
Besser wäre übrigens, wenn das Makro nur "manuell" gestartet würde. Denn sonst wird ständig kopiert, auch wenn ich die Daten anpasse :-)
Lieber Gruss
Matthias
AW: VBA: Text in die Zwischenablage kopieren wenn ...
23.11.2018 09:07:39
Herbert
Hallo Matthias,
bei mir "meckert" er nicht (s. Bild). Das kann evtl. an deinen "Trust-Center"-Einstellungen liegen, oder du hast die "Analsye-AddIns" nicht angeklickt. Check das mal!
Userbild
Servus
Anzeige
AW: VBA: Text in die Zwischenablage kopieren wenn ...
23.11.2018 10:46:32
Herbert
Hallo Matthias,
ich habe es dir umgebaut, so dass du es mit einer Schaltfläche benutzen kannst. Bei mir hat es einwandfrei funktioniert. Wenn es bei dir wieder hakt, dann prüfe deine Optionen!
https://www.herber.de/bbs/user/125601.xlsm
Servus
AW: VBA: Text in die Zwischenablage kopieren wenn ...
22.11.2018 18:40:06
Herbert
Hallo Matthias,
da fehlt noch eine Zeile, denn wenn in Spalte D "nein" steht, soll er ja nix übernehmen. Deshalb nimm diesen Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sTextClipb$, sTextUp$, sTextDown$, oText As DataObject, iCountA%, iCountB%, iRowUp%,  _
iRowDown%
If Target.Column > 1 And Target.Column  "x" Then Exit For
If Cells(iCountA, 1) = "x" Then iRowUp = iCountA
Next iCountA
For iCountB = Target.Row To Target.Row + 10
If Cells(iCountB, 1)  "x" Then Exit For
If Cells(iCountB, 1) = "x" Then iRowDown = iCountB
Next iCountB
End If
If iRowUp = 0 Or iRowDown = 0 Then End
sTextUp = "B" & iRowUp & ":C" & iRowUp
sTextDown = "B" & iRowDown & ":C" & iRowDown
sTextClipb = sTextUp & vbCrLf & sTextDown
oText.SetText sTextClipb
oText.PutInClipboard
MsgBox sTextClipb
Beep
End If
End Sub
Servus
Anzeige

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige