Copy paste VBA

[BachFel]

Guten Tag zusammen,

Ich würde gerne eine Vielzahl von Dateien (alle im gleichen Ordner) ansteuern und deren Inhalt  in eine neue Datei (Datei_konsolidierung nennen wir sie mal) kopieren. Die Dateien sind alle gleich aufgebaut und sollen (so wie es sich gehört) zu einer (Datei_konsolidierung) vereint werden.
Jetzt sollte es natürlich so sein, dass wenn alle Zeilen der ersten Datei in die Datei_konsolidierung kopiert worden sind und die Zeilen aus der nächsten Datei angefügt werden sollen, der bereits bestehende Inhalt nicht überschrieben werden soll, sondern unten angefügt werden (wie sich jeder sicher denken kann =) ).

Kann mir jemand hierzu evtl mal einen Stoß in die richtige Richtung geben, herzlichsten Dank vorab.

Grüße
Fel

[Fennek]

Hallo,

falls es die Daten der Fragebögen sein sollten, wäre es besser die Struktur gleich anzupassen.

mfg

[BachFel]

Hallo,

falls es die Daten der Fragebögen sein sollten, wäre es besser die Struktur gleich anzupassen.

mfg

Hi,
nein das Thema ist durch. Arbeite an meiner Thesis, dafür bräuchte ich das =)

[BachFel]

Code:

Sub Sammeln()
sQuellpfad = "Pfad"
QZeile = 10 'Zeile in Quelldatei
QSpalten = 15 'Spaltenanzahl
QSpalteAb = "A" ' ab dieser Spalte insgesamt "QSpalten" Spaltenwerte übernehmen
ZZeile = 10 'erste Zeile in Zieldatei
ZSpalteAb = "A" 'erste Spalte in Zieldatei
Set wbGes = ActiveWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
For Each oFile In fso.GetFolder(sQuellpfad).Files
   If LCase(Right(oFile.Name, 5)) = ".xlsx" Then 'nur ".xls"-Dateien verarbeiten; bei ".xlsx" natürlich die letzten 5 Zeichen vergleichen
       Application.Workbooks.Open oFile.Path 'Quelldatei öffnen
       'Zellen lt Vorgabe aus Quelldatei lesen und in aktuelle Zeile der Zieldatei schreiben
       wbGes.Worksheets(1).Cells(ZZeile, ZSpalteAb).Resize(1, QSpalten).Value = ActiveWorkbook.Worksheets(1).Cells(QZeile, QSpalteAb).Resize(1, QSpalten).Value
       ActiveWorkbook.Close False 'Quelldatei schließen
       ZZeile = ZZeile + 1 'Zeilennummer Zieldatei erhöhen
End If
Next
wbGes.Save 'Zieldatei speichern
End Sub

Das habe ich bis jetzt und klappt auch echt gut, allerdings wird immer nur die erste Zeile der Quelldatein übertragen.
Wie bekomme ich es hin das alles kopiert wird?

[Rabe]

Hi,

warum holst Du die Daten so aus den Zeilen und machst nicht wirklich Copy und Paste?

[Werner.M]

Hallo,

als erstes solltest du dir gleich mal angewöhnen deine Variablen zu deklarieren. Am besten benutzt du Option Explicit, dann meckert der Editor sofort, wenn eine Variable nicht deklariert wurde.

-die letzte belegte Zeile wird im Code in jeder Quelltabelle in Spalte A ermittelt.
-die letzte belegte Spalte wird im Code in jeder Quelltabelle in Zeile 10 ermittelt
-die erste freie Zelle in der Zieltabelle wird im Code in Spalte A ermittelt
-das jeweilige Schließen der geöffneten Quellmappe fehlte im Code, dann hast du z.B. beim Importieren aus 50 Mappen nach dem Makrolauf 50 offene Mappen

Teste mal:

Code:

Option Explicit

Sub Sammeln()
Dim loErsteQuelle As Long 'erste Zeile Quelle
Dim loLetzteQuelle As Long 'letzte Zeile Quelle
Dim loSpalteQuelle As Long 'letzte Spalte Quelle
Dim loErsteZiel As Long 'erste freie Zelle Zielblatt
Dim sQuellpfad As String
Dim wbGes As Workbook
Dim fso As Object
Dim oFile As Object

loErsteQuelle = 10
sQuellpfad = "Pfad"

Set wbGes = ThisWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
For Each oFile In fso.GetFolder(sQuellpfad).Files
  If LCase(Right(oFile.Name, 5)) = ".xlsx" Then 'nur ".xls"-Dateien verarbeiten; bei ".xlsx" natürlich die letzten 5 Zeichen vergleichen
      Application.ScreenUpdating = False
      Application.Workbooks.Open oFile.Path 'Quelldatei öffnen
      With ActiveWorkbook.Worksheets(1)
           'Application.ScreenUpdating = False
           'Ermitteln der letzten belegten Zeile Quellblatt, Spalte A
           loLetzteQuelle = .Cells(.Rows.Count, 1).End(xlUp).Row
           'Ermitteln der letzten belegten Spalte Quellblatt, Zeile 10
           loSpalteQuelle = .Cells(loErsteQuelle, .Columns.Count).End(xlToLeft).Column
           'Ermitteln der ersten freien Zeile Zielblatt, Spalte A
           loErsteZiel = wbGes.Worksheets(1).Cells(wbGes.Worksheets(1).Rows.Count, 1).End(xlUp).Row + 1
           If wbGes.Worksheets(1).Cells(10, 1) = "" Then loErsteZiel = 10
           .Range(.Cells(loErsteQuelle, 1), .Cells(loLetzteQuelle, loSpalteQuelle)).Copy _
           wbGes.Worksheets(1).Cells(loErsteZiel, 1)
           'geöffnete Quelldatei ohne Speichern schließen
           ActiveWorkbook.Close False
      End With
      Application.ScreenUpdating = True
End If
Next

'Zieldatei speichern
wbGes.Save
End Sub



Gruß Werner