Guten Morgen,
folgender Sachverhalt :Bereich DH2-DV10 wird per VBA erstellt, was heißen soll, es werden Zellen mit Rahmen versehen und mit Farbe gefüllt. Zelle DL6-DM6 soll verbunden werden.,was auch klappt. Dann wird dieser Bereich in 20er Schritten kopiert, aber dann bleibt die Zellformatierung nicht erhalten.
Nun wollte ich ich die Zellen separat in 20er Schritten verbinden
Wie muss ich das bewerkstelligen?
Lg Frank
Hallo Frank
Ich kann Dein Problem nicht nachvollziehen. Wenn ich DH2-DV10 oder auch nur DL6-DM6 von Hand kopiere und irgendwo einsetze, dann bleibt die Formatierung erhalten.
Was meinst Du mit: „in 20er Schritten“? DH2-DV10 wird 20 mal irgendwohin kopiert?
Machst Du das mit einem Makro? Wenn ja: Wie lautet es?
Grüsse Niclaus
Hallo Niclaus,
hier mal der Code um den es sich dreht:
Sub BoardErstellen() ’ Mit Unterstützung von Gerd L und Crazy Tom
Dim i As Integer
With Sheets(„Turnier-Board“)
Cells.Interior.ColorIndex = 1 ’ Hintergrund wird schwarz eingefärbt
’ Spaltenbreite wird zugewiesen
Columns(120).ColumnWidth = 3.29
Union(Columns(108), Columns(110), Columns(112), Columns(114), Columns(116), Columns(118), _
Columns(122), Columns(124), Columns(126), Columns(128)).ColumnWidth = 2.29
’ " Die blauen Linien dienen in der Test und Lernphase quasi als Hilfslinien "
With Rows(„20“).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 5
End With
With Columns(113).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 5
End With
With Columns(126).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 5
End With
’ " Rahmen werden erstellt Bereich Zeile 2 - Zeile 10 "
’ Range(„DL6:DM6“).MergeCells = True ’ ! Beim Kopieren des Bereichs DI2-DV10 bleibt die Formatierung nicht erhalten !
Range(„DP2,DQ2,DR2,DN3,DO3,DS3,DT3,DK4,DP4,DQ4,DR4,DM5,DU5,DG6,DL6:DM6,DU6,DV6,DP7,DQ7,DR7,DJ8,DK8,DN8,DO8,DS8,DT8,DJ9,DK9:DL9,DP9,DQ9,DR9,DH10,DI10,DW10“) _
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, ColorIndex:=2
’ !!! Syntax für .Borders(xlEdgeLeft),.Borders(xlEdgeRight)usw. geht nur über ein With- Anweisung !!!
With Range(„DN4,DJ4:DJ7,DL7,DW7:DW9,DN7“).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Range(„DJ4“).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
With Range(„DT4,DT7,DG7:DG9“).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 2
End With
’ " Die Zellen werden mit den entsprechenden Farben gefüllt "
Range(„DP2, DP4, DP7, DP9“).Interior.ColorIndex = 5 'Blau
Range(„DQ2, DQ4, DQ7, DQ9“).Interior.ColorIndex = 46 'Orange
Range(„DR2, DN3, DT3, DR4, DV6, DR7, DJ8, DN8, DT8, DJ9, DR9, DH10“).Interior.ColorIndex = 15 'Hellgrau
Range(„DS3, DU6, DS8“).Interior.ColorIndex = 4 'Grün
Range(„DU5, DK9, DL9“).Interior.ColorIndex = 33 'Hellblau
Range(„DK4, DM5, DG6“).Interior.ColorIndex = 3 'Rot
Range(„DO3, DL6, DM6, DK8, DO8, DI10“).Interior.ColorIndex = 44 'Ockergelb
Range(„DW10“).Interior.ColorIndex = 7 'Magenta
’ " Da sich der Bereich DI2-DV10 alle 20 Zeilen wiederholt,wird er kopiert "
For i = 2 To 622 Step 20
.Range(„DI2:DV10“).Copy .Cells(i, 113)
If i = 622 Then Exit For
.Range(„DI2:DV10“).Copy .Cells(i + 20, 113)
Next
End With
End Sub
Und nach dem kopieren,ist die Formatierung weg.Ich hoffe du verstehst nun was ich meine.
Lg Frank
Ich hoffe du verstehst nun was ich meine.
Hallo Frank
Ich hoffe es auch! Du meinst DL6:DM6? Du hast ganz oben erwähnt:
Zelle DL6-DM6 soll verbunden werden, was auch klappt.
Das stimmt nicht! Diese zwei Zellen sind nicht verbunden! Sie haben nur die gleiche Zellfarbe! Das steht übrigens auch im Code! Etwa Zeile 25.
’ Range(„DL6:DM6“).MergeCells = True ’ ! Beim Kopieren des Bereichs DI2-DV10 bleibt die Formatierung nicht erhalten !
Diese Zeile ist sogar auskommentiert, also unwirksam!
Ich habe schnell versucht, im Code Aenderungen vorzunehmen, bis jetzt leider ohne Erfolg. Bevor ich weitermache, musst Du mir sagen, ob wirklich das Dein Problem ist. Müssen diese zwei Zellen wirklich verbunden sein? Wenn ja, kann ich diese Riesentabelle noch einmal anschauen! Bin gespannt!
Viele Grüsse Niclaus
Hallo Niclaus,
da es nicht geklappt hat,kann es sein,das ich den Code auskommentiert habe. Mittlerweile habe ich dieses Problem aber lösen können:
Dim i As Integer, Z As Integer
For Z = 6 To 626 Step 20 ' Mit Unterstützung von Uli
Worksheets("Turnier-Board").Range(Cells(Z, 116), Cells(Z, 117)).MergeCells = True
Next
Lg Frank