Bereiche in andere Arbeitsmappe kopieren

Hallo Experten!
Ich habe folgendes Problem:
Ich habe verschiedene Arbeitsmappen mit jeweils einem Tabellenblatt (immer identisch aufgebaut). Hier werden in den Bereichen A2-L2, A5-L5 und A9- L9 Daten eingegeben und diese möchte ich in eine andere Arbeitsmappe (besteht bereits) kopieren. Soweit so gut.
Die Daten aus dem Bereich A2-L2 sollen in das erste Tabellenblatt der neuen Arbeitsmappe kopiert werden. Dort ebenfalls in den Bereich A2-L2. Die Daten aus A5-L5 in das zweite Tabellenblatt usw. Hierbei müssen alle Formate aus der Ursprungsmappe übernommen werden und vor allem habe ich nun noch folgendes Problem:
Habe ich den ersten Datensatz kopiert, kommt die nächste Arbeitsmappe (gleicher Aufbau) und auch diese Datensätze sollen in die andere Arbeitsmappe nach dem gleichen Schmema kopiert werden. Allerdings immer in die Zeile unter dem bereits vorhandenden Datensatz. Quasi ein Zusammenfügen aller Daten.
Das kriege ich nicht hin. Ich hoffe, ihr könnt mir da weiterhelfen und habt eine Lösung parat. Vielen DANK!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub TestFürKopieInZielmappe() Range("A2:L2").Select Selection.Copy Windows("Zielmappe.xls").Activate ActiveSheet.Paste Windows("Datenmappe.xls").Activate Range("A5:L5").Select Application.CutCopyMode = False Selection.Copy Windows("Zielmappe.xls").Activate Sheets("Tabelle2").Select ActiveSheet.Paste Windows("Datenmappe.xls").Activate Range("A8:L8").Select Application.CutCopyMode = False Selection.Copy Windows("Zielmappe.xls").Activate Sheets("Tabelle3").Select Range("A2").Select ActiveSheet.Paste End Sub

Function dabei helfen würde, aber weiß nicht wie ich das genau einbinden/kombinieren müsste bzw. ob es mein Problem lösen kann. Brauche echt eure Hilfe! Dank im Voraus! Option Explicit Function lngLetzteZeile() As Long Dim i As Integer, lngMin As Long, lngMax As Long For i = 1 To 256 lngMin = Cells(65536, i).End(xlUp).Row If lngMax < lngMin Then lngMax = lngMin End If Next i lngLetzteZeile = lngMax End Function

Hallo Thorsten,
habe hier deine Wünsche einmal umgesetzt. Dateinamen musste halt ggf. anpassen. Dabei wird die Zieldatei zu beginn des Makros geöffnet. In einer Schleife können dann nach einander die Datendateien geöffnet werden.


Sub DatenEinlesen()
Dim wbZiel As Workbook, wbQuelle As Workbook, rngDaten As Range, i As Integer
Dim Bereich(1 To 3) As String
Dim Zeile(1 To 3) As Long 'Oberen Index festlegen entsprechend der Anzahl Bereiche die Kopiert werden sollen
Set wbZiel = Workbooks.Open(Filename:="C:\Lokale Daten\Test\Ziel.xls") 'Datei in die die Daten kopiert werden sollen
Bereich(1) = "A2:L2" 'Bereich, der in 1. Tabelle kopiert werden soll
Bereich(2) = "A5:L5" 'Bereich, der in 2. Tabelle kopiert werden soll
Bereich(3) = "A9:L9" 'Bereich, der in 3. Tabelle kopiert werden soll
'Nächste frei Zielzeile in den Tabellen der Zieltabellen ermitteln
For i = 1 To UBound(Zeile)
With wbZiel.Sheets(i)
Zeile(i) = .UsedRange.Row + .UsedRange.Rows.Count
'Alternative Möglichkeit
'Nachfolgend Spalte wählen in der immer Daten stehen!
'Zeile(i) = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
Next i
Do
'Datendatei öffnen
Datei = Application.Dialogs(xlDialogOpen).Show
If Datei = False Then Exit Sub
Application.ScreenUpdating = False
Set wbQuelle = ActiveWorkbook
'Formate und Daten aus den Bereichen in die Zieltabellen kopieren
For i = 1 To UBound(Bereich)
Set rngDaten = wbQuelle.Sheets(1).Range(Bereich(i))
rngDaten.Copy
With wbZiel.Sheets(i)
.Cells(Zeile(i), "A").PasteSpecial Paste:=xlFormats
.Cells(Zeile(i), "A").PasteSpecial Paste:=xlValues
End With
Zeile(i) = Zeile(i) + 1
Next i
Application.CutCopyMode = False
wbQuelle.Close Savechanges = False
Application.ScreenUpdating = True
wbZiel.Save
Loop Until MsgBox("Weitere Datei bearbeiten?", vbQuestion + vbYesNo, "Daten einlesen") = vbNo
wbZiel.Close
End Sub

Gruß
Franz

Beliebteste Forumthreads (12 Monate)

Bereiche in andere Arbeitsmappe kopieren

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

85 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bereiche in andere Arbeitsmappe kopieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

85 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread