Zeilen kopieren per Mausklick?

Forumthread: Zeilen kopieren per Mausklick?

06.02.2023 16:26:06

Sandra

Hallo Profis
Ich habe Tabellen mit bis zu 2'000 Zeilen (Artikeldaten).
Nun hätte ich gerne ein Makro, das Folgendes kann:
- in der gleichen Arbeitsmappe ein neues Tabellenblatt "Inventur" erstellen
- Messagebox in der Tabelle: "Welche Zeile möchten Sie kopieren?"
- wenn auf eine Zeile geklickt wird, die komplette Zeile im Tabellenblatt "Inventur" in die erste freie Zeile kopieren
- Messagebox "Die Zeile ... wurde kopiert. Weitere Zeile kopieren?" (Evtl. lässt sich in der Tabelle die bereits schon kopierte Zeile z.B. mit Farbe markieren?)
- solange fragen, bis "nein" geklickt wird
Funktioniert das, wenn die Zeile mit Mausklick ausgewählt werden soll?
Ich freue mich auf ein Echo und bin sehr gespannt.
Herzlichen Dank jetzt schon

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zeilen kopieren per Mausklick?

06.02.2023 16:33:13

Rudi
AW: Zeilen kopieren per Mausklick?

06.02.2023 16:58:58

Sandra
AW: Zeilen kopieren per Mausklick?

06.02.2023 17:06:32

onur
AW: Zeilen kopieren per Mausklick?

06.02.2023 18:09:15

Rudi

AW: Zeilen kopieren per Mausklick?

06.02.2023 16:33:13

Rudi

Hallo,
wo ist denn da der Mehrwert?
1. Blatt Inventur erstellen
2. Zeilen mit gedrückter Strg-Taste markieren
3. kopieren
4. einfügen
Gruß
Rudi

AW: Zeilen kopieren per Mausklick?

06.02.2023 16:58:58

Sandra

Danke für deine Antwort, aber ich suche eine Makro-Lösung.
Der Anwender muss aus der Tabelle möglichst schnell einzelne Zeilen kopieren können, während er gleichzeitig in einem Gespräch ist.

AW: Zeilen kopieren per Mausklick?

06.02.2023 17:06:32

onur

Dann solltest du vielleicht mal Hilfe erbitten, statt zu schreiben: "Ich hätte gerne:" Hier ist keine Bestellannahme. :)

AW: Zeilen kopieren per Mausklick?

06.02.2023 18:09:15

Rudi

Option Explicit
Sub aa()
  Dim w As Worksheet, i As Worksheet, r As Range
  On Error Resume Next
  Set w = ActiveSheet
  Set i = Worksheets("Inventur")
  On Error GoTo 0
  If i Is Nothing Then
    Set i = Worksheets.Add
    i.Name = "Inventur"
  End If
  w.Activate
  Do
    On Error Resume Next
    Set r = Application.InputBox("Zellen markieren", , , , , , , 8)
    On Error GoTo 0
    If Not r Is Nothing Then
      Set r = r.EntireRow
      r.Copy i.Cells(Rows.Count, 1).End(xlUp).Offset(1)
      r.Interior.Color = vbRed
    Else
      Exit Sub
    End If
  Loop Until MsgBox("Weiter?", vbYesNo) = xlNo
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Forumthread: Zeilen kopieren per Mausklick?

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread