Zeilen in andere Datei kopieren

Sub kopiereZeile() Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim rngRow As Range Set wsSource = Worksheets("tabelle1") Set wsTarget = Worksheets("tabelle2") For Each rngRow In wsSource.Range("A2", wsSource.Range("A2").SpecialCells(xlCellTypeLastCell)). _ Rows If rngRow.Cells(1, 20) "" Then rngRow.Copy wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Offset(1) End If Next rngRow End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub kopiereZeile() Dim wsSource As Worksheet Dim wbTarget As Workbook Dim wsTarget As Worksheet Dim rngRow As Range Set wsSource = ActiveWorkbook.Worksheets("tabelle1") Set wbTarget = Workbooks("DeineDatei2.xlsx") Set wsTarget = wbTarget.Worksheets("tabelle2") For Each rngRow In wsSource.Range("A2", wsSource.Range("A2").SpecialCells(xlCellTypeLastCell)). _ Rows If rngRow.Cells(1, 20) <> "" Then rngRow.Copy wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Offset(1) End If Next rngRow End Sub

Erstmals danke , ich hab den Code angepasst, was noch fehlt:
die wbTarget hat x Blätter, ich möchte die gerne nacheinander abfragen, und (for i = 2 to Worksheets.count ?)) und dann in Blatt x kopieren.
als Beispiel: 7 Blätter, sind wie folgt benannt: Frage1, Frage2 etc....
Die Zeilen sollen dann in die in das wbSource Blatt1, Blatt2 etc kopiert werden, und das krieg ich nicht unter.
Und das Set wsTarget = wbTarget.Worksheets("Frage1") verhindert das natürlich.

Sub kopiereZeile()
Dim wsSource As Worksheet
Dim wbTarget As Workbook
Dim wsTarget As Worksheet
Dim strFilter As String
Dim strFileName As String
Dim Frage As String
Dim rngRow As Range
Set wsSource = ActiveWorkbook.Worksheets("tabelle1")
strFilter = "Excel-Dateien(*.xlsx), *.xlsx" '** Dateifilter definieren
ChDrive "Q"
ChDir "Q:\xxxxxxx\" '** Laufwerk und Pfad _
definieren, welcher geöffnet werden soll
'** Den im Dialogfeld gewählten Namen auslesen
strFileName = Application.GetOpenFilename(strFilter)
Set wbTarget = Workbooks.Open(strFileName)
Set wsTarget = wbTarget.Worksheets("Frage1")
For Each rngRow In wsTarget.Range("A2", wsTarget.Range("A2").SpecialCells( _
xlCellTypeLastCell)). _
Rows
If rngRow.Cells(1, 1)  "" Then
rngRow.Copy wsSource.Cells(wsTarget.Rows.Count, 1).End(xlUp).Offset(1)
End If
Next rngRow
End Sub

Option Explicit Sub kopiereZeile() Dim wbSource As Workbook Dim wsSource As Worksheet Dim wbTarget As Workbook Dim wsTarget As Worksheet Dim strFilter As String Dim strFileName As String Dim rngRow As Range Dim Blatt As Worksheet Set wbSource = ActiveWorkbook Set wsSource = ActiveWorkbook.Worksheets("tabelle1") Application.ScreenUpdating = False strFilter = "Excel-Dateien(*.xlsx), *.xlsx" '** Dateifilter definieren ChDrive "X" ChDir "X:\Temp\" '** Laufwerk und Pfad _ definieren, welcher geöffnet werden soll '** Den im Dialogfeld gewählten Namen auslesen strFileName = Application.GetOpenFilename(strFilter) Set wbTarget = Workbooks.Open(strFileName) For Each Blatt In wbTarget.Sheets For Each rngRow In Blatt.Range("A2", Blatt.Range("A2").SpecialCells( _ xlCellTypeLastCell)).Rows If rngRow.Cells(1, 1) <> "" Then rngRow.Copy wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Offset(1) End If Next rngRow Next wbTarget.Close True End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen in andere Datei kopieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread