Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

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
Anzeige

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige