Bereich markieren ab bestimmten Eintrag

Hallo allerseits!
es könnte alles so schön sein, wenn nur der chef und seine ideen nicht wären... ;)
Ihc habe folgendes, wunderbares makro (natürlich mit Foren Hilfe) welches mir den benutzten bereich in den Spalten J-X markiert (ohne überschrift, deswegen "+2").
Dim i As Long
Dim Firstrow As Long
Dim Lastrow As Long
Lastrow = 0
Firstrow = Rows.Count
For i = 10 To 24
If IIf(IsEmpty(Cells(Rows.Count, i)), Cells(Rows.Count, i).End(xlUp).Row, Rows.Count) > _
Lastrow Then
Lastrow = IIf(IsEmpty(Cells(Rows.Count, i)), Cells(Rows.Count, i).End(xlUp).Row, Rows. _
Count)
End If
If IIf(IsEmpty(Cells(1, i)), Cells(1, i).End(xlDown).Row, 1) Firstrow = IIf(IsEmpty(Cells(1, i)), Cells(1, i).End(xlDown).Row, 1)
End If
Next i
'MsgBox Firstrow & " " & Lastrow
Range("J" & (Firstrow + 2), "X" & Lastrow).Select
Da jetzt aber auch in den Spalten J-X in dem Bereich über dem den ich markieren will, einträge gemacht werden sollen, funktioniert das makro natürlich nicht mehr wie ich es gerne hätte.
Ich würde es jetzt gerne so abändern, das das makro in den spalten J-X quasi meine Überschrift von dem relevanten bereich sucht und dann ab da bis zum letzten eintrag in diesen spalten markiert.
Ist das möglich? wenn ja wie?
Bin für alle Anregungen dankbar!
viele grüße
christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub tt() Dim sp As Long Dim i As Long Dim Firstrow As Long Dim Lastrow As Long Lastrow = 0 Firstrow = Rows.Count sp = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column For i = 10 To sp If IIf(IsEmpty(Cells(Rows.Count, i)), Cells(Rows.Count, i).End(xlUp).Row, Rows.Count) > _ Lastrow Then Lastrow = IIf(IsEmpty(Cells(Rows.Count, i)), Cells(Rows.Count, i).End(xlUp).Row, Rows. _ Count) End If If IIf(IsEmpty(Cells(1, i)), Cells(1, i).End(xlDown).Row, 1)

Option Explicit Sub tst() Dim rngL As Range, lngL As Long, lngU As Long Dim dest As Range Set rngL = Columns("J").Find(What:="Überschrift", _ LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, _ MatchCase:=True, SearchFormat:=False) If rngL Is Nothing Then MsgBox "Überschrift nicht gefunden" Else lngU = rngL.Row End If Set rngL = Columns("J:X").Find("*", Cells(1, 10), xlValues, , xlByRows, xlPrevious) If rngL Is Nothing Then MsgBox "nix gefunden" Else lngL = rngL.Row End If If lngL * lngU > 0 Then Range(Cells(lngU, 10), Cells(lngL, 24)).Copy dest End Sub

Hallo!
Danke an alle, Problem gelöst!
Robert: in deinem vorschlag war die Zeile 100 fest eingestellt, ich wollte es doch aber dynamisch... aber:
Erich: Mit einem Teil aus deinem Vorschlag in Kombination mit meinem vorhandenen hab ichs jetzt hingekriegt!
Für alle die es interessiert:
Dim rngL As Range, lngU As Long
Set rngL = Columns("J").Find(What:="Überschrift", _
LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
If rngL Is Nothing Then
MsgBox "Überschrift nicht gefunden"
Else
lngU = rngL.Row
End If
'MsgBox lngU + 2
Dim i As Long
Dim Firstrow As Long
Dim Lastrow As Long
Lastrow = 0
Firstrow = Rows.Count
For i = 10 To 24 '=Spalten J-X
If IIf(IsEmpty(Cells(Rows.Count, i)), Cells(Rows.Count, i).End(xlUp).Row, Rows.Count) > _
Lastrow Then
Lastrow = IIf(IsEmpty(Cells(Rows.Count, i)), Cells(Rows.Count, i).End(xlUp).Row, Rows. _
Count)
End If
If IIf(IsEmpty(Cells(1, i)), Cells(1, i).End(xlDown).Row, 1) Firstrow = IIf(IsEmpty(Cells(1, i)), Cells(1, i).End(xlDown).Row, 1)
End If
Next i
'MsgBox Firstrow & " " & Lastrow
Range("J" & (lngU + 2), "X" & Lastrow).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Ich bin ziemlich sicher, dass sich die profis jetzt totlachen, aber egal, so gehts! :)
nochmals vielen dank, viele grüße und ein schönes Wochenende!
gruss
christian

Beliebteste Forumthreads (12 Monate)

Bereich markieren ab bestimmten Eintrag

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread