Markierungsproblem

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread