AW: Mehrfachbereich um 14 Zeilen erweitern
14.01.2011 14:01:03
Peter
Hallo Rudi
Vielen Dank.
Es scheint noch etwas nicht ganz zu funktionieren. Bei
Set rngL = Range("SpaDelCont").Resize(15)
stoppt der Code
Im Endergebnis möchte ich, dass der grün markierte Bereich mit "SpaDelCont" benannt ist.
Wäre super, wenn mir jemand hilft, das zum Laufen zu bringen.
Gruss, Peter
https://www.herber.de/bbs/user/73078.xls
Option Explicit
Sub Test()
Dim rGross As Range, sSH As String, spAnfang As Long, spEnde As Long
sSH = ActiveSheet.Name
spAnfang = 1: spEnde = 71
Set rGross = Range(Cells([zeQuelle].Row, spAnfang), Cells([zeQuelle].Row, spEnde))
Call DefBereichNichtinBereich(rGross, "SpaDelCont", sSH, "Fix")
End Sub
Sub DefBereichNichtinBereich(rGross As Range, sKlein As String, sTabNam As String, sID As _
String)
Dim rngCell As Range, rngL As Range
Dim rngGross As Range
Set rngGross = rGross
For Each rngCell In rGross
If UCase(rngCell.Text) UCase(sID) Then
If rngL Is Nothing Then
Set rngL = rngCell
Else
Set rngL = Union(rngL, rngCell)
End If
End If
Next
Set rngL = rngL.Offset(6 - [zeQuelle].Row, 0) 'Zellen aller Spalten im Bereich ohne Fix von _
Zeile 2 auf 6 wechseln
Debug.Print rngL.Address
If Not rngL Is Nothing Then
Names.Add sKlein, RefersTo:=Sheets(sTabNam).Range(rngL.Address(True, True))
Set rngL = Range("SpaDelCont").Resize(15)
End If
End Sub