Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1860to1864
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 Kopieren und Transponieren

VBA Kopieren und Transponieren
31.12.2021 13:59:16
Begeistert
Hallo.
Ich bräuchte Hilfe bei meiner Excel Datei mit einer VBA Programmierung.
Ich habe 2 Tabellenblätter Ausgabe und Verteilung Aufbau.
Bei Tabellenblatt Ausgabe habe ich 2 Spalten AI5:AI1004 mit Sicherungsbezeichnung und AJ5:AJ1004 mit Etage-Raum-Gerät.
Diese Werte möchte ich kopieren, aber nur wenn etwas drinsteht.
Der Text sollte in das Tabellenblatt Verteilung Transponiert werden (Quer geschrieben).
Davor sollte der Bereich A-Y ab Zeile 41 runter zuerst gelöscht werden.
Für das Transponieren sollte aber der Text in eine Zelle mit 2 Spalten geschrieben werden ab B41.
Es sollte immer 12 Sicherungen in einer Zeile sein. Dann darunter eine neue Zeile anfangen.
Im Anhang habe ich eine Excel Datei. https://www.herber.de/bbs/user/150080.xlsm
Bei Tabellenblatt Verteilung habe ich schon 2 Einträge reingeschrieben.
Mit einem Button wir das VBA dann gestartet (Behersche ich aber).
Vielen Dank im Vorraus für das Helfen.

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

Betreff
Datum
Anwender
Anzeige
AW: VBA Kopieren und Transponieren
02.01.2022 15:50:25
Piet
Hallo
das beigefügte Makro in ein Modul kopieren und per Button starten. Ein frohes, gesundes und glückliches neues Jahr wünscht ein alter Elektroniker ...
mfg Piet
  • 
    Sub Elektroverteilung_ausfüllen()
    Dim AC As Range, j, ag, lzAg As Long
    Dim VT As Worksheet, vZeile, vSpalte
    Set VT = Worksheets("Verteilung")
    VT.Range("B41:Y500").ClearContents
    With Worksheets("Ausgabe")
    lzAg = .Cells(Rows.Count, "Ai").End(xlUp).Row
    vSpalte = 2: j = 0    '1.Spalte in Verteilung
    vZeile = 41: ag = 5   '1.Zeile der Liste
    Do Until ag > lzAg
    'Auflisten wenn Werte in  AI gefunden werden
    If .Cells(ag, "AI")  "" Then
    VT.Cells(vZeile, vSpalte) = .Cells(ag, "AI")
    VT.Cells(vZeile + 1, vSpalte) = .Cells(ag, "AJ")
    vSpalte = vSpalte + 2
    If vSpalte > 25 Then MsgBox "Mehr als 12 Sicherungen in Zeile " & ag
    Else  'Leerzellen übersrpingen
    For j = ag To ag + 20
    If .Cells(j + 1, "AI")  "" Then Exit For
    Next j:  ag = j  'Leerzellen übersrpingen
    vSpalte = 2: vZeile = vZeile + 2
    End If
    ag = ag + 1  'Zelle in Ausgabe +1
    Loop
    End With
    End Sub
    

  • Anzeige
    AW: VBA Kopieren und Transponieren
    02.01.2022 17:49:46
    Begeister
    Hallo Piet.
    Vielen Dank für das lösen der VBA Programmierung.
    Klappt Prima.
    Wünsche auch ein gutes Neues Jahr und Gesundheit.
    AW: Danke für die nette Rückmeldung oWt
    02.01.2022 18:31:00
    Piet
    ,,,

    301 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige