VBA Kopieren und Transponieren

Forumthread: 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

AW: VBA Kopieren und Transponieren

02.01.2022 15:50:25

Piet
AW: VBA Kopieren und Transponieren

02.01.2022 17:49:46

Begeister
AW: Danke für die nette Rückmeldung oWt

02.01.2022 18:31:00

Piet

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

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

,,,

Beliebteste Forumthreads (12 Monate)

Forumthread: VBA Kopieren und Transponieren

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread