AW: Bereiche transponieren
06.02.2010 22:33:25
Josef
Hallo Peter,
probier mal.
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub transposeRange()
Dim objSh As Worksheet
Dim vntRange As Variant
For Each objSh In ThisWorkbook.Worksheets
If IsNumeric(objSh.Name) Then
vntRange = objSh.Range("A1:BQ8")
objSh.Range("A1:BQ8") = ""
vntRange = TransposeDim(vntRange)
objSh.Range("A1").Resize(UBound(vntRange, 1), UBound(vntRange, 2)) = vntRange
Erase vntRange
End If
Next
Set objSh = Nothing
End Sub
Private Function TransposeDim(Field As Variant) As Variant
Dim lngX1 As Long, lngY1 As Long, lngX2 As Long, lngY2 As Long
Dim varTmp As Variant
lngX1 = LBound(Field, 2)
lngX2 = UBound(Field, 2)
lngY1 = LBound(Field, 1)
lngY2 = UBound(Field, 1)
Redim varTmp(1 To lngX2, 1 To lngY2)
For lngX1 = 1 To lngX2
For lngY1 = 1 To lngY2
varTmp(lngX1, lngY1) = Field(lngY1, lngX1)
Next
Next
TransposeDim = varTmp
End Function
Gruß Sepp