Zeilen in andere Datei kopieren

Forumthread: Zeilen in andere Datei kopieren

23.10.2018 10:50:56

Georg

Liebe Mitglieder,
ich würde gerne was zw. zwei Dateien kopieren, komm aber mit zwei (geöffneten) Dateien und den Tabellenblätter (anzahl x) in der Quelle nicht ganz klar.
Die Zieldatei ist offen und startet den Code.
Die Quelle möchte ich über den Öffnen Dialog öffnen (krieg ich hin).
1. Es sollen aus der Quelle dann im tabellenblatt 2 alle Zeilen kopiert werden, solange bis zum letzten Wert in Spalte A. (Dazwischen sind leere Zeilen!)
2. Das Ziel ist Zieldatei.Tabellenblatt 2.
3. Dann wieder zurück zur Quelle, tabellenblatt 3, weiter wie oben, Ziel Zieldatei.Tabellenblatt 3 etc.
Die einfache Variante zwischen zwei Worksheets habe ich noch hingekriegt, ich freue mich auf ein paar Ergänzungen DANKE.

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

AW: Zeilen in andere Datei kopieren

23.10.2018 11:54:47

UweD

Hallo
ungetestet...
Du musst das Workbook noch mit berücksichtigen
so?

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

LG UweD

AW: Zeilen in andere Datei kopieren

23.10.2018 12:20:44

Georg

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

AW: Zeilen in andere Datei kopieren

23.10.2018 13:09:11

UweD

hallo nochmal
so?

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

LG UweD

AW: es geht alles auf ein Blatt

23.10.2018 13:24:25

Georg

..aber ich lasse es mal so, vielleicht muss ich mir grundsätzlich noch eine andere Lösung suchen. ABER VIELEN DANK GEORG

AW: es geht alles auf ein Blatt

23.10.2018 14:01:54

UweD

Hallo nochmal
also die Blattnamen der beiden Dateien heißen gleich.
dann so? ungeprüft...
änder die eine Zeile von / in
von:

                      rngRow.Copy wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Offset(1)

in:

                      With wbTarget.Sheets(Blatt.Name)
rngRow.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
End With

LG UweD

Beliebteste Forumthreads (12 Monate)

Forumthread: Zeilen in andere Datei kopieren

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Zeilen in andere Datei kopieren

Forumthread: Zeilen in andere Datei kopieren

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread