Microsoft Excel

Herbers Excel/VBA-Archiv

Wert kopieren und in anderen Sheet einfügen


Betrifft: Wert kopieren und in anderen Sheet einfügen von: Sam
Geschrieben am: 24.01.2019 09:54:31

Hallo,
Ich habe eine excel Datei mit zwei Arbeitsblätter. In Arbeitsblatt 2 steht in Spalte K ja oder neine. Ich hätte gerne dass wenn in Spalte K "ja" steht, es mir den Wert aus Spalte H kopieret und in eine leere Zeile im Arbeitsblatt 1 (in Spalte E) einfügt.
Hier ist mein Code. Mein Code läuft (ohne Buggs) aber es wird nichts kopiert und eingefügt. Könnt ihr mir vielleicht damit helfen oder sagen wo mein problem ist?

Sub Kopieren()
 
Dim M As Long, intRowM As Long
Dim Wert As String
Dim T As Long, intRowT
intRowM = Worksheets("MockUp").Cells(Rows.Count, 11).End(xlUp).Row
For M = intRowM To 1 Step -1
    If Cells(M, 11).Value = "Ja" Then
        Wert = Cells(M, 8).Value
        intRowT = Worksheets("ToDo").Cells(Rows.Count, 5).End(xlUp).Row
        For T = intRowT To 1 Step -1
            If IsEmpty(Cells(T, 5).Value) Then
                Cells(T, 5).Value = Wert
            End If
        Next T
    End If
Next M
 
 
End Sub
Vielen Dank :)

  

Betrifft: AW: Wert kopieren und in anderen Sheet einfügen von: Torsten
Geschrieben am: 24.01.2019 14:30:54

Hallo,

du must dem Code schon sagen, von welcher Tabelle zu welcher Tabelle. Also immer die Tabellenblaetter referenzieren. Dann klappt das auch mit dem Code.

Sub Kopieren()
 
Dim M As Long, intRowM As Long
Dim Wert As String
Dim T As Long, intRowT
intRowM = Worksheets("MockUp").Cells(Rows.Count, 11).End(xlUp).Row
For M = intRowM To 1 Step -1
    If Worksheets("MockUp").Cells(M, 11).Value = "Ja" Then
        Wert = Worksheets("MockUp").Cells(M, 8).Value
        intRowT = Worksheets("ToDo").Cells(Rows.Count, 5).End(xlUp).Row
        For T = intRowT To 1 Step -1
            If IsEmpty(Worksheets("ToDo").Cells(T, 5).Value) Then
                Worksheets("ToDo").Cells(T, 5).Value = Wert
            End If
        Next T
    End If
Next M
 
End Sub
Oder halt mit der "With" Anweisung

Gruss Torsten


  

Betrifft: AW: Wert kopieren und in anderen Sheet einfügen von: Torsten
Geschrieben am: 24.01.2019 14:51:04

Hab aber gerade festgestellt, dass nur der erste Wert kopiert wird.
Ich schaue es mir morgen nochmal an


  

Betrifft: AW: Wert kopieren und in anderen Sheet einfügen von: Torsten
Geschrieben am: 25.01.2019 07:06:24

Hallo nochmals Sam,

hab jetzt den Code komplett ueberarbeitet mit der "With" Anweisung. Ist einfach kuerzer.
Also wird jetzt wie gewuenscht der Wert aus Tabelle "MockUp" Spalte H in Tabelle "ToDo" in Spalte E in die erste freie Zelle kopiert, wenn in Tabelle "MockUp" in Spalte K ein "Ja" steht (Gross/Kleinschreibung beachten, muss exakt sein wie im Code).

Hier der Code:

Sub Kopieren1()
 
Dim M As Long, intRowM As Long
Dim Wert As String
Dim WS1 As Worksheet, WS2 As Worksheet
Dim T As Long, intRowT

Set WS1 = Sheets("MockUp")
Set WS2 = Sheets("ToDo")

With WS1
    intRowM = .Cells(Rows.Count, 11).End(xlUp).Row
    For M = intRowM To 1 Step -1
    
        If .Cells(M, 11).Value = "Ja" Then
            Wert = .Cells(M, 8).Value
            
            With WS2
                intRowT = .Range("E1").End(xlDown).Row + 1
                .Cells(intRowT, 5) = Wert
            End With
            
        End If
        
    Next M
End With
  
End Sub
Gruss Torsten


  

Betrifft: AW: Wert kopieren und in anderen Sheet einfügen von: Torsten
Geschrieben am: 25.01.2019 07:07:21

Hallo nochmals Sam,

hab jetzt den Code komplett ueberarbeitet mit der "With" Anweisung. Ist einfach kuerzer.
Also wird jetzt wie gewuenscht der Wert aus Tabelle "MockUp" Spalte H in Tabelle "ToDo" in Spalte E in die erste freie Zelle kopiert, wenn in Tabelle "MockUp" in Spalte K ein "Ja" steht (Gross/Kleinschreibung beachten, muss exakt sein wie im Code).

Hier der Code:

Sub Kopieren1()
 
Dim M As Long, intRowM As Long
Dim Wert As String
Dim WS1 As Worksheet, WS2 As Worksheet
Dim T As Long, intRowT

Set WS1 = Sheets("MockUp")
Set WS2 = Sheets("ToDo")

With WS1
    intRowM = .Cells(Rows.Count, 11).End(xlUp).Row
    For M = intRowM To 1 Step -1
    
        If .Cells(M, 11).Value = "Ja" Then
            Wert = .Cells(M, 8).Value
            
            With WS2
                intRowT = .Range("E1").End(xlDown).Row + 1
                .Cells(intRowT, 5) = Wert
            End With
            
        End If
        
    Next M
End With
  
End Sub
Gruss Torsten


  

Betrifft: AW: Wert kopieren und in anderen Sheet einfügen von: Sam
Geschrieben am: 25.01.2019 08:02:19

Hey Torsten,

Vielen Dank für den Code!!! :)

Gruß Samuel


Beiträge aus dem Excel-Forum zum Thema "Wert kopieren und in anderen Sheet einfügen"