Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1788to1792
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

Transportieren

Transportieren
21.10.2020 12:39:47
Tom
Hallo zusammen,
gibt es hierfür ein variables Makro?
Gewisse Datenmenge in Spalte A markieren / Irgendeine Zelle B mit Cursor markieren / Transportieren
Danke
TOM

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

Betreff
Datum
Anwender
Anzeige
AW: Transportieren
21.10.2020 12:46:38
Daniel
Hi
mit folgendem Ablauf:
Werte in Spalte A durch runterziehen der Markierung markieren.
Zelle in Spalte B mit gedrückter STRG-Taste der Markierung hinzufügen.
dann dieses Code ausführen:
Selection.Areas(1).Copy
Selection.Areas(2).PasteSpecial xlpasteall
Areas sind bei einer Selection/Zellbereich, der mit STRG aus mehreren Blöcken zusammengestellt wurde, die einzelnen rechteckigen lückenlosen blöcke.
Gruß Daniel
AW: Transponieren
21.10.2020 12:54:45
Nepumuk
Hallo Tom,
teste mal:
Option Explicit

Public Sub Transponieren()
    Dim objRangeSource As Range, objRangeTarget As Range
    Dim objRangeCollection As Collection
    Set objRangeCollection = New Collection
    Do
        objRangeCollection.Add Application.InputBox(Prompt:= _
            "Bitte die Quelle markieren", Title:="Auswahl", Type:=8)
        If TypeOf objRangeCollection(objRangeCollection.Count) Is Range Then
            Set objRangeSource = objRangeCollection(objRangeCollection.Count)
            Exit Do
        ElseIf IsEmpty(objRangeCollection(objRangeCollection.Count)) Then
            MsgBox "Objektzuweisung fehlgeschlagen. Bitte nochmal versuchen", _
                vbCritical, "Fehlermeldung"
        ElseIf Not objRangeCollection(objRangeCollection.Count) Then
            Exit Sub 'cancelbutton pressed
        Else
            MsgBox "Fehler " & CStr(vbObjectError) & vbLf & vbLf & _
                "Unbekannter Objektfehler beim zuweisen eines Bereiches.", _
                vbCritical, "Fehlermeldung"
            Exit Sub
        End If
    Loop
    Set objRangeCollection = New Collection
    Do
        objRangeCollection.Add Application.InputBox(Prompt:= _
            "Bitte die Zielzelle markieren", Title:="Auswahl", Type:=8)
        If TypeOf objRangeCollection(objRangeCollection.Count) Is Range Then
            Set objRangeTarget = objRangeCollection(objRangeCollection.Count)
            Exit Do
        ElseIf IsEmpty(objRangeCollection(objRangeCollection.Count)) Then
            MsgBox "Objektzuweisung fehlgeschlagen. Bitte nochmal versuchen", _
                vbCritical, "Fehlermeldung"
        ElseIf Not objRangeCollection(objRangeCollection.Count) Then
            Exit Sub 'cancelbutton pressed
        Else
            MsgBox "Fehler " & CStr(vbObjectError) & vbLf & vbLf & _
                "Unbekannter Objektfehler beim zuweisen eines Bereiches.", _
                vbCritical, "Fehlermeldung"
            Exit Sub
        End If
    Loop
    Call objRangeSource.Copy
    Call objRangeTarget.Cells(1, 1).PasteSpecial( _
        Paste:=xlPasteValuesAndNumberFormats, Transpose:=True)
    objRangeTarget.Cells(1, 1).Select
    Application.CutCopyMode = False
End Sub

Gruß
Nepumuk
Anzeige
AW: Transponieren
21.10.2020 13:07:25
Tom
Perfekt Vielen Dank!!!

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige