Markierungsproblem

Forumthread: Markierungsproblem

Markierungsproblem

24.07.2006 17:06:31

Max

Hallo Experten.
manchmal markiert der folgende code in x-richtung weiter als bis zur letzten unbeschriebenen Zelle vor der nächsten beschriebenen..
Die y richtung stimmt. woran liegt das?
Danke Max
Windows("Report_OrdersOfApplication.xls").Activate
Sheets("Pivot Data").Select
Set rng = ActiveSheet.UsedRange.Find("PG NIC TE 4", LookIn:=xlValues)
Do
i = i + 1
Loop Until rng.Offset(i, 0) ""
Range(rng, rng.Offset(i - 1, 3)).Select
Selection.Copy
Windows("endversion.xls").Activate
Sheets("Daten aus Tabelle").Select
Range("B1").Select
ActiveSheet.Paste

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Markierungsproblem

24.07.2006 17:58:09

Erich
AW: Markierungsproblem - Korrektur

24.07.2006 18:09:28

Erich
AW: Markierungsproblem - Korrektur 2

24.07.2006 18:20:30

Erich

AW: Markierungsproblem

24.07.2006 17:58:09

Erich

Hallo Max,
warum machst du hier einen neuen Thread auf?
Wiw wäre es mit einer Antwort in
https://www.herber.de/forum/messages/784734.html
später im Archiv:
https://www.herber.de/forum/archiv/784to788/t784734.htm
gewesen?
Probiers mal hiermit:

Option Explicit
Sub werte_int_ext()
Dim rng As Range
Dim i As Long
Windows("Report_OrdersOfApplication.xls").Activate
Sheets("Pivot Data").Select
Set rng = ActiveSheet.UsedRange.Find("PG NIC TE 4", LookIn:=xlValues)
If rng Is Nothing Then
MsgBox "Suchbegriff nicht gefunden", vbCritical
Exit Sub
End If
If Not IsEmpty(rng.Offset(1, 0)) Then
i = rng.Row
Else
i = rng.End(xlDown).Row - 1
If i + 1 >= Rows.Count Then
MsgBox "Keine beschriebene Zelle unter dem Suchbegriff", vbCritical
Exit Sub
End If
End If
Range(rng, rng.Offset(i - 1, 3)).Copy Destination:= _
Workbooks("endversion.xls").Sheets("Daten aus Tabelle").Range("B1")
' nur, wenn das jetzt wirklich aktiviert werden soll:
Workbooks("endversion.xls").Activate
Sheets("Daten aus Tabelle").Select
Range("B1").Select
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Markierungsproblem - Korrektur

24.07.2006 18:09:28

Erich

Hallo Max,
sorry, da hatte ich eine falsche Version gepostet. Also nochmal:

Option Explicit
Sub werte_int_ext()
Dim rng As Range
Dim i As Long
Windows("Report_OrdersOfApplication.xls").Activate
Sheets("Pivot Data").Select
Set rng = ActiveSheet.UsedRange.Find("PG NIC TE 4", LookIn:=xlValues)
If rng Is Nothing Then
MsgBox "Suchbegriff nicht gefunden", vbCritical
Exit Sub
End If
If Not IsEmpty(rng.Offset(1, 0)) Then
i = rng.Row
Else
i = rng.End(xlDown).Row - 1
If i + 1 >= Rows.Count Then
MsgBox "Keine beschriebene Zelle unter dem Suchbegriff", vbCritical
Exit Sub
End If
End If
Range(rng, rng.Offset(i - 1, 3)).Copy Destination:= _
Workbooks("endversion.xls").Sheets("Daten aus Tabelle").Range("B1")
' nur, wenn das jetzt aktivierrt werden soll:
Workbooks("endversion.xls").Activate
Sheets("Daten aus Tabelle").Select
Range("B1").Select
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Markierungsproblem - Korrektur 2

24.07.2006 18:20:30

Erich

Hallo noch mal,
es ist heiß heute... (Beim Copy stand immer noch die falsche Version.)
Die Find-Parameter habe ich noch ergänzt, damit die Suche weniger vom Zufall abhängt.

Option Explicit
Sub werte_int_ext()
Dim rng As Range
Dim i As Long
Windows("Report_OrdersOfApplication.xls").Activate
Sheets("Pivot Data").Select
Set rng = ActiveSheet.UsedRange.Find("PG NIC TE 4", _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If rng Is Nothing Then
MsgBox "Suchbegriff nicht gefunden", vbCritical
Exit Sub
End If
If Not IsEmpty(rng.Offset(1, 0)) Then
i = rng.Row
Else
i = rng.End(xlDown).Row - 1
If i + 1 >= Rows.Count Then
MsgBox "Keine beschriebene Zelle unter dem Suchbegriff", vbCritical
Exit Sub
End If
End If
Range(rng, Cells(i, rng.Column + 2)).Copy Destination:= _
Workbooks("endversion.xls").Sheets("Daten aus Tabelle").Range("B1")
' nur, wenn das jetzt wirklich aktiviert werden soll:
Workbooks("endversion.xls").Activate
Sheets("Daten aus Tabelle").Select
Range("B1").Select
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

Forumthread: Markierungsproblem

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread