Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Werte per Makro von einem Tabellenblatt zum anderen übertragen mit Bedingung
#1
Hallo zusammen,

komme nicht weiter bei der Übertragung von Werten ohne Formeln von einem zum anderen Tabellenblatt.
Die Werte sollen bei Erfüllung der Bedingung, dass in der Spalte "H" der Wert <> 0 von Tabelle1 auf Tabelle2 übertragen werden ohne die Leerzeilen zu kopieren. Wenn die Bedingung nicht erfüllt ist, soll nichts passieren.
Hier mein bisheriges Makro (s. dazu auch die Beispieldatei):

Sub test()
Dim i As Long, r As Long
Dim aWks As Worksheet, bWks As Worksheet
Set aWks = Worksheets("Tabelle1")
Set bWks = Worksheets("Tabelle2")
With aWks
    For i = 1 To 16
        If .Cells(i, 8).Value <> "0" Then
            r = bWks.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Debug.Print r
            With bWks
                .Range(.Cells(r, 6)).Value = aWks.Range(aWks.Cells(i, 1)).Value
            End With
        End If
    Next i
End With
End Sub


Vor "End With" kommt der Laufzeitfehler mit einem nicht definiertem Ojekt/Methode.

Wer kann mir weiterhelfen? Das Makro soll möglichst effizient sein, da es in der tatsächlichen Datei um mehrere Hundert Zeilen geht. die geprüft werden sollen auf den Wert <> "0"
Danke im Voraus für Eure Mühe.

Grüße
NobX


Angehängte Dateien
.xlsm   Testmappe1.xlsm (Größe: 20,13 KB / Downloads: 3)
Antworten Top
#2
Hallo,

versuche es mal damit:

Code:
Sub übertrag()
    Dim lngZeile As Long
    Tabelle1.Range("A2").CurrentRegion.AutoFilter Field:=8, Criteria1:=">0", _
        Operator:=xlAnd
    lngZeile = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A2:I" & lngZeile).SpecialCells(xlCellTypeVisible).Copy _
        Destination:=Tabelle2.Range("A6")
End Sub
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Antworten Top
#3
Hallo Klaus-Dieter,

danke für deinen Vorschlag. Grundsätzlich funktioniert Deine Version. Es werden mir beim Einfügen die vorhandenen Formatierungen gelöscht und durch den Autofilter in Tabelle 1 werden die anderen Zeilen ausgeblendet. Diese sollen für weitere Eingaben sichtbar bleiben. Kannst Du mir noch einen Vorschlag machen, wie ich den Code abändern kann um in Tabelle2 die Formatierungen beizubehalten und in Tabelle 1 ohne alle Zellen sichtbar bleiben?
Wenn`s klappt, wäre super.
Habe die Datei mit dem neuen Code noch einmal beigefügt.

Grüße
NobX


Angehängte Dateien
.xlsm   Testmappe2.xlsm (Größe: 20,17 KB / Downloads: 3)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste