Fehler 1004

Dim i As Integer, LetzteZeile As Integer Dim srchStr As Variant Dim wksWatch As Worksheet Dim wksIm As Worksheet Dim c As Range Sub Aktualisieren() Set wksWatch = Worksheets("Watchlist") Set wksIm = Worksheets("Import") Application.ScreenUpdating = False LetzteZeile = Range("A65536").End(xlUp).Row For i = 4 To LetzteZeile With Sheets("Import").Range(Cells(4, 1), Cells(LetzteZeile, 1)) srchStr = wksIm.Cells(i, 1).Value Set c = .find(srchStr, LookIn:=xlValues) If Not c Is Nothing Then ----> Range(Cells(c.Row, c.Column + 1), Range(Cells(c.Row, Cells(c.Row, 256).End(xlToRight).Column))).Copy Sheets("Watchlist").Cells(i, 2).PasteSpecial Application.CutCopyMode = False End If End With Next i Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Bert,
Leider kommt jetzt der Fehler:
Die Methode 'Range' für das Objekt '_Worksheet' ist fehlgeschlagen.
Ich hab hier nochmal den ganzen Code aufgeführt ( ein Sorry an Ramses, dass ich den Code geändert gepostet hab, aber anders hatte es auch die Fehlermeldung gegeben!)
Änderungen hier:Blattnamen bzw. die Zuweisungen vor Cells und Range.
(Nochmal das Grund-Problem: in der Watchlist stehen ein paar Datensätze, in Import alle
Die in Import sind immer aktuell. Die Watchlist soll sich aus dem Importsheet aktualisieren.)


Sub Aktualisieren()
Dim c As Range
Dim i As Integer, LetzteZeile As Integer
Dim wksWatch As Worksheet, wksIm As Worksheet
Dim srchStr As Variant
Set wksWatch = Worksheets("Watchlist")
Set wksIm = Worksheets("Import")
Application.ScreenUpdating = False
On Error GoTo Schluss
LetzteZeile = wksIm.Range("A65536").End(xlUp).Row
For i = 4 To LetzteZeile
With wksIm.Range(wksIm.Cells(4, 1), wksIm.Cells(LetzteZeile, 1))
srchStr = wksWatch.Cells(i, 1).Value
Set c = .Find(srchStr, LookIn:=xlValues)
If Not c Is Nothing Then
wksIm.Range(wksIm.Cells(c.Row, c.Column + 1), wksIm.Range(wksIm.Cells(c.Row, Cells(c.Row, 256).End(xlToRight).Column))).Copy
wksWatch.Cells(i, 2).PasteSpecial
Application.CutCopyMode = False
End If
End With
Next i
ErrorExit:
Application.ScreenUpdating = True
Exit Sub
Schluss:
MsgBox "Es ist folgender Fehler aufgetreten:" & vbCrLf & Err.Number & ": " & Err.Description
Resume ErrorExit
End Sub

Weitere Hilfe wäre sehr nett!
Gruß Stephan

Hallo
ich habe den Code geprüft.
Da war etwas des guten zuviel drin :-)
Aber dafür, dass er aus der Hand geschrieben war ohne zu testen, trotzdem nicht schlecht
wksIm.Range(Cells(c.Row, c.Column + 1), Cells(c.Row, Cells(c.Row, 256).End(xlToRight).Column)).Copy
So hätte es heissen müssen.
Hier nochmal der ganze Code:

Option Explicit
Sub Aktualisieren()
Dim c As Range
Dim i As Integer, LetzteZeile As Integer
Dim wksWatch As Worksheet, wksIm As Worksheet
Dim srchStr As Variant
Set wksWatch = Worksheets("Watchlist")
Set wksIm = Worksheets("Import")
Application.ScreenUpdating = False
On Error GoTo Schluss
LetzteZeile = wksIm.Range("A65536").End(xlUp).Row
For i = 4 To LetzteZeile
    With wksIm.Range(wksIm.Cells(4, 1), wksIm.Cells(LetzteZeile, 1))
        srchStr = wksWatch.Cells(i, 1).Value
        Set c = .Find(srchStr, LookIn:=xlValues)
        If Not c Is Nothing Then
            wksIm.Range(Cells(c.Row, c.Column + 1), Cells(c.Row, Cells(c.Row, 256).End(xlToRight).Column)).Copy
            wksWatch.Cells(i, 2).PasteSpecial
            Application.CutCopyMode = False
        End If
    End With

Next i
ErrorExit:
Application.ScreenUpdating = True
Exit Sub
Schluss:
MsgBox "Es ist folgender Fehler aufgetreten:" & vbCrLf & Err.Number & ": " & Err.Description
Resume ErrorExit
End Sub

Der Code wurde getestet und die Daten wurden korrekt übertragen.
Gruss Rainer

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread