AW: Daten ohne Lerrzeilen Transponieren
07.05.2011 09:11:47
fcs
Hallo Stephan,
passiert schon mal, dass man bei einer frage nicht gleich an alle Randbedingungen denkt.
Normal könnte man jetzt Spezial-Kopieren und jeweils nur Format+Werte für jede Zelle ins Blatt Auswertung kopieren.
Du verwendest jedoch bedingte Formatierungen. Da generiert Excel im Blatt Auswertung zumindest unter Excel 2007 für jede Zelle 3 Einträge in der Liste der bedingten Formatierungen. Ich kenne hier jetzt nicht die max. zulässige Anzahl, aber erfahrungsgemäß gibt es in Excel für fast alles irgendeine Obergrenze.
Damit es hier nicht ggf. Probleme gibt werden vom Makro im Archiv-Blatt nach jedem Eintrag einer Zeile alle Daten komplett neu formatiert. Ich hoffe, das passt dann so.
Gruß
Franz
Sub AbInsArchiv()
Dim wksQuelle As Worksheet, Zeile As Long
Dim wksZiel As Worksheet, ZeileZiel As Long, SpalteZiel As Long
Set wksQuelle = ActiveSheet
Set wksZiel = Worksheets("Auswertung")
'Nächste Zielzeile ermitteln
With wksZiel
ZeileZiel = Application.WorksheetFunction.Max(4, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
SpalteZiel = 0
End With
'Werte der Zellen übertragen
With wksQuelle
'Zeilen in Spalte B an Zeile 4 abarbeiten
Application.ScreenUpdating = False
For Zeile = 4 To .Cells(.Rows.Count, 2).End(xlUp).Row
If Not IsEmpty(.Cells(Zeile, 2)) Then
SpalteZiel = SpalteZiel + 1
wksZiel.Cells(ZeileZiel, SpalteZiel) = .Cells(Zeile, 2)
End If
Next
End With
'Zielblatt Formatieren
With wksZiel
'Datum/Zeit-Format übertragen
wksQuelle.Range("B4").Copy
.Range(.Cells(4, 2), .Cells(ZeileZiel, 1)).PasteSpecial Paste:=xlPasteFormats
'Formate - speziel bedingte Formate für restlichen Datenbereich im Zielblatt setzen.
With .Range(.Cells(4, 2), .Cells(ZeileZiel, _
.Cells.SpecialCells(xlCellTypeLastCell).Column))
.ClearFormats
wksQuelle.Range("B5").Copy
.PasteSpecial Paste:=xlPasteFormats
End With
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub