AW: Kreuztabelle mit km-Angaben
15.12.2007 15:23:33
Hajo_Zi
Hallo Jan,
veändere doch den Code zum schreiben der Vorgabe
Dim LoLetzte As Long
' letzte belegte Zeile unabhängig von Excelversion für Spalte B (2)
With Worksheets("Orte")
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, . _
Rows.Count)
End With
With Worksheets("Entfernungen")
Worksheets("Orte").Range("B4:B" & LoLetzte).Copy .Range("A2")
With .Range("A2:A" & LoLetzte - 2)
.Font.Bold = True
.Interior.ColorIndex = 37
End With
Worksheets("Orte").Range("B4:B" & LoLetzte).Copy
.Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
With .Range(.Cells(1, 2), .Cells(1, LoLetzte - 2))
.Font.Bold = True
.Interior.ColorIndex = 37
End With
With .Range(.Cells(2, 2), .Cells(LoLetzte - 2, LoLetzte - 2))
.HorizontalAlignment = xlRight
.Font.Size = 8
.Interior.ColorIndex = 34
End With
End With
With Worksheets("Fahrtzeit")
Worksheets("Orte").Range("B4:B" & LoLetzte).Copy .Range("A2")
With .Range("A2:A" & LoLetzte - 2)
.Font.Bold = True
.Interior.ColorIndex = 37
End With
Worksheets("Orte").Range("B4:B" & LoLetzte).Copy
.Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
With .Range(.Cells(1, 2), .Cells(1, LoLetzte - 2))
.Font.Bold = True
.Interior.ColorIndex = 37
End With
With .Range(.Cells(2, 2), .Cells(LoLetzte - 2, LoLetzte - 2))
.HorizontalAlignment = xlRight
.Font.Size = 8
.Interior.ColorIndex = 34
End With
End With
Application.CutCopyMode = False
Vielleicht bringt auch die Abshaltung des Bildschirnmes was.
Gruß Hajo