Wer suchet, der findet ! DRINGEND !
07.06.2005 18:51:55
Stefan
ich glaube, für die vorliegende Herausforderung bedarf es wirklich eines Freaks. Eigentlich sollte ich mit diesem mühsam zusammengebauten Skript auch zum Erfolg kommen, jedoch hat das ganze einen kleinen Haken. Obwohl ich der Funktion alle nötigen Daten übergebe, setzt die
Sub alle Ranges auf den Wert des gerade im Workbook makierten Worksheets. Eigentlich sollte die
Sub ja mit der "For each blatt..."-Anweisung eben alle Durchlaufen. So scheint die Variable lastR immer nur den Rang-Unterwert für das aktiiverte Sheet anzunehmen.
Ich verzweifle schon halb oder sehe den Wald vor lauter Bäumen nicht....
'Funktion : GetLastRow
'Autor : 06.06.2005
Function GetLastRowWS(ws As Worksheet, Optional spalte As Integer = 1) As Long
With ws
GetLastRowWS = Rows.Count
If ws.Cells(GetLastRowWS, spalte).Value = "" Then GetLastRowWS = Cells(GetLastRowWS, spalte).End(xlUp).Row
End With
End Function
'Prozedur : DatenRangesBilden
'Autor : 06.06.2005
Sub DatenRangesBilden()
Dim i As Long, lastR As Long
Dim blatt As Worksheet
For Each blatt In ActiveWorkbook.Sheets
lastR = GetLastRowWS(blatt, 4)
ActiveWorkbook.Names.Add Name:=blatt.Name, RefersTo:= _
"=" & blatt.Name & "!" & _
"$28:$" & lastR
Next blatt
End Sub