Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeilen in andere Datei kopieren

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

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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

Anzeige
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
Anzeige
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

322 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige