VBA Datentransfer in anderes Workbook

Hallo zusammen,
ich habe ein kleines Problem und brauche eure Hilfe.
Aus einer Pivottabelle mit 7 Spalten (A-G) möchte ich, dass in Spalte B nach einen Wert gesucht wird.
Wenn dieser Wert (x >0,25) erfüllt wird, möchte ich, dass die Spalte A und B in ein anderes Workbook (Tabelle1 und Spalte E und F) kopiert werden.
Bedingung im InputFile ist, dass die neuen Zeilen unten angefügt werden.
Ich denke, es ist eine Schleife. Meinen Code füge ich mal an:

Sub Transfer()
Dim rngZelle As Range
'Dim Score As String
Dim wbStart As Workbook
Dim wbZiel As Workbook
Set wbStart = ActiveWorkbook
Set wbZiel = Workbooks.Open("C:\Users\benutzername\Desktop\Dateninput.xlsx")
For Each rngZelle In wbStart("Tabelle1").Range("B:B")
If rngZelle.Value > 0.25 Then
rngZelle.Cells(, -1).Copy Destination:=wbZiel.Sheets("Tabelle1").Range("E2")
End If
Next rngZelle
End Sub

Mein Problem ist, dass die erste Zeile der Schleifen bereits einen Fehler hat. Ich hoffe ihr könnt mir helfen!
Vielen Dank schon mal.
Liebe Grüße
Thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Transfer() Dim rngZelle As Range Dim Score As String Dim wbStart As Workbook Dim wbZiel As Workbook Set wbStart = ActiveWorkbook Set wbZiel = Workbooks.Open("C:\Users\bernertt\Desktop\Dateninput.xlsx") For Each rngZelle In Range("B:B") If rngZelle.Value > 0.25 Then rngZelle.Range("A:B").Copy Destination:=wbZiel.Worksheets(Tabelle1).Range("E2") End If Next rngZelle End Sub

dim cnt as long cnt = 2 for i =1 to letztezeile if rngZelle.Cells(i, "B") > 0.25 then wbZiel.Sheets("Tabelle1").Cells(cnt ,"E") =rngZelle.Cells(i, "B") wbZiel.Sheets("Tabelle1").Cells(cnt ,"D") =rngZelle.Cells(i, "A") cnt = cnt +1 end if next

Sub Transfer2() Dim rngZelle As Range Dim Score As String Dim wbStart As Workbook Dim wbZiel As Workbook Dim cnt As Long cnt = 2 Set wbStart = ActiveWorkbook Set wbZiel = Workbooks.Open("C:\Users\bernertt\Desktop\Dateninput.xlsx") For i = 1 To letztezeile If rngZelle.Cells(i, "B") > 0.25 Then wbZiel.Sheets("Tabelle1").Cells(cnt, "F") = rngZelle.Cells(i, "B") wbZiel.Sheets("Tabelle1").Cells(cnt, "E") = rngZelle.Cells(i, "A") cnt = cnt + 1 End If Next End Sub

Sub Transfer2() Dim rngZelle As Range Dim Score As String Dim wbStart As Workbook Dim wbZiel As Workbook Dim cnt As Long cnt = 2 letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row Set wbStart = ActiveWorkbook Set wbZiel = Workbooks.Open("C:\Users\bernertt\Desktop\Dateninput.xlsx") For i = 1 To letztezeile If rngZelle.Cells(i, "B") > 0.25 Then wbZiel.Sheets("Tabelle1").Cells(cnt, "F") = rngZelle.Cells(i, "B") wbZiel.Sheets("Tabelle1").Cells(cnt, "E") = rngZelle.Cells(i, "A") cnt = cnt + 1 End If Next End Sub

Sub Transfer() Dim rngZelle As Range, wbStart As Workbook, wbZiel As Workbook Set wbZiel = ThisWorkbook Set wbZiel = Workbooks.Open("C:\Users\benutzername\Desktop\Dateninput.xlsx") With wbStart.Worksheets("Tabelle1") For Each rngZelle In .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row) If rngZelle > 0.25 Then With wbZiel.Worksheets("Tabelle1") .Cells(.Cells(.Rows.Count, "E").End(xlUp).Offset(1).Row, "E").Resize(, 2).Value = _ rngZelle.Offset(, -1).Resize(, 2).Value End With End If Next rngZelle End With Set wbStart = Nothing: Set wbZiel = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

VBA Datentransfer in anderes Workbook

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Datentransfer in anderes Workbook

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread