Auswertung @ Josef Ehrensberger
14.01.2005 09:08:28
Tina
Entschuldige, dass ich Dich schon wieder belästige,
aber ich habe Deinen Code von der Auswertung noch
weiter angepasst.
Und wie nicht anders zu erwarten, bekomm ich schon
wieder ne Fehlermeldung. Wär nett, wenn Dus Dir anschauen könntest.
Run-time error '438':
Object doesn't support this property or method
bei folgener Zeile:
With wksZ.Rows("8:65536")
Ich hab echt keinen Plan, woran das liegen kann.
Vielleicht hast Du ne Ahnung.
Hier der Code (Hoffe, Du blickst durch):
Option Explicit
Function mPath() 'Globaler Root Path
mPath = "G:\Groups\AMR\amro\___STATISTIKEN AMRO\Leerstand und MZ Entwicklung\Grösste_Leerstände\SwissRE\objekte"
End Function
Sub RunCode()
Dim icount As Integer
Dim s As String
Dim code As String
Dim wksQ As Worksheet
Dim i As Integer
Dim ss As Integer
Set wksQ = Workbooks("Daten_Leerstand.xls").Worksheets("Sheet3")
For i = 2 To 2
s = Workbooks("Daten_Leerstand.xls").Worksheets("Sheet3").Cells(i, 2)
If InStr(1, ss, s) = 0 Then
Exportieren s
ss = ss & "," & s
icount = icount + 1
End If
Next i
MsgBox "Done: " & icount & " " & code & wksQ.Cells(2, 1) & " Leerstand-Liste importiert"
End Sub
Private Sub Exportieren(code As String)
Dim wksQ As Worksheet 'Quelltabelle
Dim wksZ As Workbook 'Zieltabelle
Dim rng As Range
Dim lastRow As Long, lRow As Long, lFirst As Long
Dim n As Integer
Dim m As Integer
Set wksQ = Sheets("Sheet3")
Set wksZ = Workbooks.Open(mPath & "\Leerstände.xls")
wksZ.SaveAs mPath & "\Output\Leerstände_" & wksQ.Cells(2, 1) & "_" & wksQ.Cells(2, 17) & ".xls"
Workbooks("Daten_Leerstand.xls").Worksheets("Sheet3").Activate
With wksZ.Rows("8:65536")
.ClearContents
.ClearFormats
End With
lRow = 8
lFirst = 8
lastRow = IIf(wksQ.Range("A65536") <> "", 65536, wksQ.Range("A65536").End(xlUp).Row)
For Each rng In wksQ.Range("B2:B" & lastRow)
With rng
.EntireRow.Copy wksZ.Cells(lRow, 1)
If rng.Offset(1, 0) <> rng Then
For n = 6 To 15 'Spalten von ... bis, welche mit Formeln berechnet werden
wksZ.Cells(lRow + 1, 1) = "Total"
wksZ.Cells(lRow + 1, 1).Font.Bold = True
wksZ.Cells(lRow + 1, n) = "=SUM(R[" & -(lRow - lFirst + 1) & "]C:R[-1]C)" 'gibt Summenergebnis als Formel aus
wksZ.Cells(lRow + 1, n).Interior.ColorIndex = 15
wksZ.Cells(lRow + 1, 1).Interior.ColorIndex = 15
wksZ.Cells(lRow + 1, 2).Interior.ColorIndex = 15
wksZ.Cells(lRow + 1, 3).Interior.ColorIndex = 15
wksZ.Cells(lRow + 1, 4).Interior.ColorIndex = 15
wksZ.Cells(lRow + 1, 5).Interior.ColorIndex = 15
wksZ.Cells(lRow + 1, 16).Interior.ColorIndex = 15
wksZ.Cells(lRow + 1, 17).Interior.ColorIndex = 15
'wksZ.Cells(lRow + 1, n) = _
'Application.Sum(wksZ.Range(wksZ.Cells(lFirst, n), wksZ.Cells(lRow, n))) 'gibt Summenergebnis als Wert aus
wksZ.Cells(lRow + 1, n).Font.Bold = True
wksZ.Cells(lRow + 1, n).NumberFormat = "#,##0.00"
Next
lRow = lRow + 1
lFirst = lRow + 1
End If
lRow = lRow + 1
End With
Next
'wksZ.Close True
End Sub
Danke für alle Ansätze.
Gruss Tina