Bei bestimmtem Zellwert Zeilen kopieren

Liebe Profis!
Ich habe mir mit googlen und Basiskenntnissen ein Makro geschrieben, welches leider nicht funktioniert, und ich komme bei der Analyse selbst nicht mehr weiter.
Folgendes Szenario:
Ich habe eine Datei mit mehreren Sheets(Anzahl kann variieren).
Das letzte Sheet ist immer das Zielsheet namens "Handlungsbedarf".
In jedem Sheet ist eine identische Formatierung.
Es wird der kalkulierte Preis mit dem tatsächlichen Preis verglichen, in Spalte F steht die Differenz in %.
Per Button sollen nun alle Datensheets ausgelesen werden. Wenn in Spalte F ein Wert kleiner als 0 steht, dann soll diese Zeile (A-F) ins Zielsheet "Handlungsbedarf" kopiert werden.
Das ist der Code:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim intTabellen, i, i2 As Integer
intTabellen = ActiveWorkbook.Sheets.Count - 1
For i = 1 To intTabellen
ActiveWorkbook.Sheets(i).Select
For i2 = 2 To 54
If ActiveSheet.Cells(i2, 6)

Als Fehlermeldung kommt immer Laufzeitfehler 438: Objekt unterstützt diese Eigenschaft oder Methode nicht.
Kann mir jemand hier helfen?
Vielen Dank im Voraus!
Michael

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Michael,
du hast ein paar Schreibfehler (Sheet statt Sheets z. B.).
Ausserdem ist es quatsch die Tabellen zu selectieren.

Private Sub CommandButton1_Click()
  Dim intTabellen As Integer, intCount, intRow As Integer
  Dim lngNext As Long

  intTabellen = ActiveWorkbook.Sheets.Count - 1

  lngNext = Sheets("Handlungsbedarf").Cells(Rows.Count, 1).End(xlUp).Row + 1

  For intCount = 1 To intTabellen
    With Sheets(intCount)
      For intRow = 2 To 54
        If .Cells(intRow, 6) < 0 Then
          .Range(.Cells(intRow, 1), .Cells(intRow, 6)).Copy Sheets("Handlungsbedarf").Cells(lngNext, 1)
          lngNext = lngNext + 1
        End If
      Next intRow
    End With
  Next intCount

End Sub

Gruß Sepp

Option Explicit Private Sub CommandButton1_Click() Dim intTab As Integer, intZei As Integer, wks As Worksheet Set wks = ActiveWorkbook.Worksheets("Handlungsbedarf") 'wks.UsedRange.ClearContents Application.ScreenUpdating = False For intTab = 1 To ActiveWorkbook.Sheets.Count - 1 With ActiveWorkbook.Sheets(intTab) For intZei = 2 To 54 If .Cells(intTab, 6)

Beliebteste Forumthreads (12 Monate)

Bei bestimmtem Zellwert Zeilen kopieren

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bei bestimmtem Zellwert Zeilen kopieren

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

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread