Automatisch Rahmen erstellen
28.12.2020 11:06:46
Ulrich
ich habe eine Frage.
Mit folgendem Code übertrage ich Daten aus einem Tabellenblatt in in eine Übersichtsliste.
Nach Start des Makro "To Do uebertragen" werden erst alle Daten gelöscht und dann neu eingelesen.
Jetzt hätte ich gerne, das
1. die neu eingelesenen Daten einen Rahmen bekommen (innen und Außen)
(beim Neustart des Makro sollten dieser Rahmen auch wieder gelöscht werden, mit den Daten)
2. in Spalte A ab Zeile 6 mit den neu eingelesenen Daten eine fortlaufende Nummer generiert wird.
Kann mir hierbei jemand helfen?
Danke vorab
Gruß Ulli
Sub To_Do_Uebertragen()
Dim i, j As Integer
Worksheets("Übertrag to do").Unprotect Password:=""
j = 6
With Worksheets("Übertrag to do").Range("B6:F45")
.Value = ""
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Worksheets("Übertrag to do").Range("B6:F45").Font
.Name = "Arial"
.Size = 10
.Bold = False
.ColorIndex = 0
End With
Worksheets("Übertrag to do").Range("C6:C45").HorizontalAlignment = xlGeneral
Worksheets("Übertrag to do").Range("B6:B45").Font.Bold = True
For i = 7 To 300 Step 1
If Worksheets("G-Muster").Rows(i).Hidden = False Then
If Not Worksheets("G-Muster").Cells(i, 10).Value = "" Then
Worksheets("Übertrag to do").Cells(j, 2).Value =
Worksheets("G-Muster ").Cells(i, 1).Value
Worksheets("Übertrag to do").Cells(j, 3).Value =
Worksheets("G-Muster ").Cells(i, 7).Value
Worksheets("Übertrag to do").Cells(j, 4).Value =
Worksheets("G-Muster ").Cells(i, 9).Value
Worksheets("Übertrag to do").Cells(j, 5).Value =
Worksheets("G-Muster ").Cells(i, 10).Value
Worksheets("Übertrag to do").Cells(j, 6).FormulaLocal = "=WENN(G-Muster!K" & i & _
"="""";"""";WENN(G-Muster!L" & i & "="""";"""";""P""))"
With Worksheets("Übertrag to do").Cells(j, 6).Font
.Name = "Wingdings 2"
.Size = 16
.Bold = True
.Color = -16711936
End With
With Worksheets("Übertrag to do").Cells(j, 6)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
j = j + 1
End If
End If
Next i
End Sub
