Format mit VBA übertragen

Hallo zusammen,
vorneweg: Dies sind meine ersten VBA und Forenversuche, also bei Unvollständigkeit meiner Angaben gerne fragen :)
Ziel: Ich möchte mittels einer Drop-Down-Liste im Sheet "Output" in einem Feld (A2) zwischen "Layout1", "Layout2" ... "LayoutN" auswählen können, wie sich die rechts davon befindliche Zeile (B2:M/N/O/P2) formatiert.
Die Drop-Down-Liste im Sheet "Output" ist eingerichtet. Jetzt müsste mein Makro wissen, dass wenn in A2 "Layout2" steht, es im Sheet "Layout" den Namen "Layout2" sucht (steht hier in B3) und dann einen Bereich dahinter (inklusive der Startzelle; B3:N3) markiert. Anschließend soll es den Pinsel drücken und es auf die Zelle hinter "Layout2" im Sheet "Layout" übertragen (also im Beispiel B2).
Das ganze soll er dann für A3, A4, ... wiederholen, sodass zuerst die Drop-Downs festgelegt werden können und dann über einen Knopf das Makro aktiviert werden kann.
Die folgenden Infos habe ich durch Aufzeichnung von Makros und Recherche zusammengetragen. Leider funktioniert davon auch im Einzeltest irgendwie relativ wenig und leider ist es auch erstmal nur auf die Zelle A2 ausgerichtet.

Sub Makro1()
' Makro1 Makro
' Test für Layout mit VBA
Sheets("Output").Select
If ("A2") = "Layout1" Then
Sheets("Layout").Range("B3:N3").Select
End If
If ("A2") = "Layout2" Then
Sheets("Layout").Range("B5:N5").Select
End If
Selection.Copy
Sheets("Output").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Vielen Dank im Voraus für eure Hilfe!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub layouts(OZ As Long) ' OZ wie Output-Zeile Dim c As Range Const von = "B" Const bis = "N" Set c = Sheets("Layout").Range("A:A").Find(Range("A" & OZ)) If Not c Is Nothing Then Sheets("Layout").Range(von & c.Row & ":" & bis & c.Row).Copy ActiveSheet.Range(von & OZ).PasteSpecial Paste:=xlPasteFormats End If End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 1 And Target.Value Like "Layout*" Then layouts (Target.Row) Cancel = True End If End Sub

Hi Michael,
vielen Dank zunächst für deine Antwort. Ich versuche es jetzt seit gut 5 Stunden, kann es aber leider nicht nachvollziehen, oder für meine Datei anpassen. Immerhin habe ich inzwischen entdeckt, dass sich das Makro irgendwie zweiteilt und das hier im Bild aufgelistete gar nicht alles ist. Ich schätze, das war es, was du mit weiterem Makro Modul. Ich habe mir mal alles ausgedruckt und versucht in eine normale Sprache zu übersetzen, was wo passiert, aber irgendwie scheinen 1,5 Tage VBA Erfahrung überraschenderweise nicht zu reichen.
Mögliche Probleme bei mir könnten sein, dass die Outputtabelle in Spalte B startet und dass die Layouts nicht Layout1 oder Layout2 heißen, sondern z.B. sowas wie "Überschrift Unterstrich (0,0,0)". Ich habe versucht B und N zu C und O umzubauen. Im gleichen Zug habe ich A:A in B:B gewechselt. Außerdem habe ich das "Layout*" mal durch "*" ersetzt...
Ich habe auch mal versucht, mein Layout in deine Datei zu übertragen und auch hier schätze ich, scheitert es am Ende an den Namen der Zeilen, die eben nicht mehr "LayoutN" sind...
Konnte man mit meinem Anfangscode gar nichts anfangen? Ich hatte den zwischenzeitlich sogar noch etwas erweitert, allerdings raucht mir ohnehin jetzt der Kopf ;)
Das blöde ist, früher oder später hilft es mir nicht nur, das umgesetzt zu haben, sondern ich muss es auch verstehen und anderen erklären können.
LG Benaldo

Option Explicit Sub mehrLayouts(zvon As Long, zbis As Long, welches As String, blatt As Worksheet) Dim c As Range Const von = "B" Const bis = "N" ' Hier Spalte A mit Layout-Begriffen durch Spalte B ersetzt 'Set c = Sheets("Layout").Range("A:A").Find(welches) Set c = Sheets("Layout").Range("B:B").Find(welches) If Not c Is Nothing Then Sheets("Layout").Range(von & c.Row & ":" & bis & c.Row).Copy blatt.Range(von & zvon & ":" & bis & zbis).PasteSpecial Paste:=xlPasteFormats End If End Sub Sub ML_aufrufen() Dim zeilevon As Long, zeilebis As Long zeilevon = 3 zeilebis = 10 Call mehrLayouts(zeilevon, zeilebis, "Layout1", Sheets("Tabelle3")) MsgBox "schau mal Tabelle3 an" End Sub

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Format mit VBA übertragen

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

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread