Laufzeitfehler '1004':

[excl50]

Hallo zusammen,

ich bekomme bei meinem Makro einen Anwendungs- und objektdefinierten Fehler. Bei dem Makro soll wenn in Spalte J der einen Tabelle der Wert über 1 ist, der Wert der rechten Nachbarzelle in die entsprechende Zelle in Spalte A einer anderen Tabelle kopiert werden.

Das Makro:

Sub Makro1()
Dim AnzahlZellenSpalteJ, Bereich
AnzahlZellenSpalteJ = Tabelle3.Cells(Rows.Count, 10).End(xlUp).Row
Bereich = Range("J19:J " & AnzahlZellenSpalteJ)
If Bereich > 0 Then
Dim letztezeile
letztezeile = Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row
Bereich.Offset(0, 1).Copy
Tabelle2.Range("A: " & letztezeile + 1).PasteSpecial Paste:=xlPasteValues
Tabelle3.Range("C4").Value = Tabelle3.Range("C4").Value + Bereich.Offset(0, 1)
Bereich.Offset(0, -2) = Bereich.Offset(0, -1)
Bereich.Offset(0, 0) = 0
End If
End Sub


Vielen Dank für eure Hilfe

[Werner.M]

Hallo,

da hat so einiges nicht gepasst.
Versuch mal:

Code:

Option Explicit

Sub Makro1()
Dim loZeilen As Long, loLetzte As Long
Dim raBereich As Range, raZelle As Range

loZeilen = Tabelle3.Cells(Tabelle3.Rows.Count, 10).End(xlUp).Row
loLetzte = Tabelle2.Cells(Tabelle2.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set raBereich = Tabelle3.Range("J19:J" & loZeilen)
MsgBox raBereich.Address

For Each raZelle In raBereich
   If IsNumeric(raZelle.Value) Then
       If raZelle.Value > 1 Then
           Tabelle2.Range("A" & loLetzte) = raZelle.Offset(0, 1)
           Tabelle3.Range("C4").Value = Tabelle3.Range("C4").Value + raZelle.Offset(0, 1)
           raZelle.Offset(0, -2) = raZelle.Offset(0, -1)
           raZelle = 0
       End If
   End If
   Next raZelle

Set raBereich = Nothing
End Sub

Gruß Werner

[Glausius]

Hallo,

der Fehler dürfte in dieser Codezeile liegen:

Tabelle2.Range("A: " & letztezeile + 1).PasteSpecial Paste:=xlPasteValues

denn Range("A: " & letztezeile + 1) ist keine Adressenangabe!

Übrigens sollten die Variable richtig deklariert werden, Dim alleine reicht nicht aus, es fehlt die Dimensionierung - String, Long, Object usw.

[Werner.M]

Hallo,

was ich noch vergessen habe:

So wird aber immer in die gleiche Zeile der Tabelle2 (loLetzte) geschrieben. Sprich die Daten werden immer wieder überschrieben. Das hattest du in deinem Code auch so. War das so gewollt oder sollen die Daten in Tabelle2 immer in die nächste freie Zeile angefügt werden?

Wenn ja, dann:

Code:

Option Explicit

Sub Makro1()
Dim loZeilen As Long, loLetzte As Long
Dim raBereich As Range, raZelle As Range

loZeilen = Tabelle3.Cells(Tabelle3.Rows.Count, 10).End(xlUp).Row
loLetzte = Tabelle2.Cells(Tabelle2.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set raBereich = Tabelle3.Range("J19:J" & loZeilen)

For Each raZelle In raBereich
   If IsNumeric(raZelle.Value) Then
       If raZelle.Value > 1 Then
           Tabelle2.Range("A" & loLetzte) = raZelle.Offset(0, 1)
           Tabelle3.Range("C4").Value = Tabelle3.Range("C4").Value + raZelle.Offset(0, 1)
           MsgBox raZelle.Offset(, -1).Value
           raZelle.Offset(0, -2).Value = raZelle.Offset(0, -1).Value
           raZelle = 0
           loLetzte = loLetzte + 1
       End If
   End If
   Next raZelle

Set raBereich = Nothing
End Sub

Gruß Werner