AW: du kennst den Unterschied...
25.02.2019 07:36:03
Werner
Hallo Fabian,
ich habe mir lange überlegt, ob ich überhaupt auf deine "Beispielmappe" reagieren soll.
Du suchst hier Hilfe zu einem Problem, scheinst aber nicht wirklich Interesse daran zu haben auch eine gewisse Vorleistung zu erbringen.
Wie sonst soll ich mir deine Beispielmappe erklären. Ich hatte dich darum gebeten im Zielblatt einige Datensätze zu erfassen, damit man deine Zielvorstellung erkennt.
Was kommt: Ein paar Zahlen in einer ansonsten leeren Tabelle.
Im Quellblatt genau das selbe. Da hat es dann gerade mal gereicht ein paar Datumswerte und Zeiten zusätzlich zu erfassen.
Ansonsten, fast genauso leer wie das Zielblatt. Keinerlei Überschriften oder ähnliches. Was dann dort igendwann einmal wo steht und wohin kopiert werden soll, das soll ich mir aussuchen?
Ich hab jetzt trotzdem mal ein Makro geschrieben, mit dem was bei der Vorlage nachvollziehbar war.
Sub Lehrveranstaltungsankündigung()
Dim wsQ As Worksheet, wsZ As Worksheet
Dim loLetzte As Long, i As Long
Set wsQ = ThisWorkbook.Worksheets("test")
Set wsZ = ThisWorkbook.Worksheets("Ankündigung")
Application.ScreenUpdating = False
With wsZ
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Row
'Altdaten im Zielblatt löschen
If loLetzte > 6 Then
.Range(.Cells(7, 2), .Cells(loLetzte, 12)).ClearContents
End If
'bedingte Formatierung im Zielblatt löschen
.Range("B7").FormatConditions.Delete
'Daten von Quellblatt in Zielblatt kopieren
wsQ.Range(wsQ.Cells(1, 1), wsQ.Cells(wsQ.Cells(wsQ.Rows.Count, 1).End(xlUp).Row, 5)).Copy
.Cells(7, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wsQ.Range(wsQ.Cells(1, 12), wsQ.Cells(wsQ.Cells(wsQ.Rows.Count, 1).End(xlUp).Row, 12)).Copy
.Cells(7, 6).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wsQ.Range(wsQ.Cells(1, 7), wsQ.Cells(wsQ.Cells(wsQ.Rows.Count, 1).End(xlUp).Row, 8)).Copy
.Cells(7, 7).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'Kopierameisen abschalten
Application.CutCopyMode = False
'Zielblatt nach Prio in Spalte A sortieren
.Range(.Cells(7, 1), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 12)).Sort _
Key1:=.Cells(7, 1), Order1:=xlAscending
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Row
'Zielblatt Leerzeilen zwischen den Prios einfügen
For i = loLetzte To 8 Step -1
If .Cells(i, 1) wsZ.Cells(i - 1, 1) Then
.Cells(i, 1).EntireRow.Insert
End If
Next i
'Spalte A im Zielblatt leeren
.Columns(1).ClearContents
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Row
'Zielblatt bedingte Formatierung (Rahmen) setzen
.Range("B7:L" & loLetzte).FormatConditions.Add Type:=xlExpression, Formula1:="=$B7"""""
.Range("B7:L" & loLetzte).FormatConditions(Selection.FormatConditions.Count). _
SetFirstPriority
With .Range("B7:L" & loLetzte).FormatConditions(1).Borders(xlLeft)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThin
End With
With .Range("B7:L" & loLetzte).FormatConditions(1).Borders(xlRight)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThin
End With
With .Range("B7:L" & loLetzte).FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThin
End With
With .Range("B7:L" & loLetzte).FormatConditions(1).Borders(xlBottom)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThin
End With
.Range("B7:L" & loLetzte).FormatConditions(1).StopIfTrue = False
End With
Unload Me
'Variablen zurücksetzen
Set wsQ = Nothing: Set wsZ = Nothing
End Sub
Den Rest konnte ich leider meiner eingetrübten Glaskugel nicht entnehmen.
Also bitte zukünftig eine Beispielmappe mit der man auch was anfangen kann.
Gruß Werner
