Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1748to1752
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zusammenführen von Ranges in Workbook

Zusammenführen von Ranges in Workbook
01.04.2020 14:57:16
Ranges
Hallo liebe Community,
für ein Projekt muss ich zentrales Register (Excel) erstellen, dass sich aus diversen Excel-Workbooks speist.
Der Trick dabei ist, dass das zentrale Register bereits besteht. Die einzelnen Input-Workbooks sind gleich gestaltet, ich brauch aber nur einen Teil aus den einzelnen Workbooks. Diesen habe ich als Bereich/Range benannt ("Upload1")
Ich habe diverse Beiträge gelesen und schaffe es zumindest die Dialogbox (mit Multiselect) für die Auswahl der Importfiles zu öffnen. Ich finde aber keine Lösung dafür, dass die jeweiligen benannten Bereiche aus den Importfiles kopiert werden und in den (ebenfalls definierten Bereich) des Zielregisters zu kopieren. Leere Zeilen im Bereich müssten aus Übersichtsgründen ausgelassen werden. Alle Daten befinden sich jeweils auf dem 1.Arbeitsblatt der Workbooks (sowohl Inputfiles, als auch das Zielregister).
Aus Verzweifelung habe ich es auch mit Power Query versucht, komme hier aber auch nicht zum gewünschten Ergebnis. Präferiert wäre aber ein Makro, sodass mein Abnehmer lediglich den Button drückt und sich das Register dann anhand der ausgewählten Dateien aktualisiert.
Hat jemand damit Erfahrungen oder kann mir da ein paar Tipps geben? Ich wäre unendlich dankbar!
Ich vermute, dass es u.a. mit Range.Copy klappen könnte, weiß aber auch nicht, wie ich den Zielbereich im zentralen Register definiere.
Bisher habe ich folgenden Code geschrieben. Ich glaube die Definitionen könnten fehlerhaft sein, _ ich bin leider ein VBA-Anfänger (weiterführenden gescheiterten Code habe ich entfernt):

Sub Registerupload2()
'Definitionen
Dim Dateienauswählen As Variant
Dim AusgewählteDateien As String
Dim Uploadmappe As Workbook
Dim Zentralregister As Workbook
Set Zentralregister = ThisWorkbook
'Bildschirmflackern und Fehlermeldungen ausschalten
Application.ScreenUpdating = False 'Bildschirm flackern aus
Application.DisplayAlerts = False 'keine Fehlermeldungen während Upload
'Dialogbox zum Auswählen der Abteilungsregister:
Dateienauswählen = Application.GetOpenFilename(FileFilter:="Excel Files (*.xl*), *.xl*", _
Title:="Wählen Sie die Dateien für den Upload aus", _
MultiSelect:=True)
'Öffnen der ausgewählten Workbooks
Dateienauswählen = AusgewählteDateien
Set Zentralregister = Application.Workbooks.Open(AusgewählteDateien)
'Bildschirmflackern und Fehlermeldungen einschalten
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zusammenführen von Ranges in Workbook
01.04.2020 15:21:38
Ranges
Hi Jan
Sub Registerupload2()
'Definitionen
Dim i As Long
Dim Dateienauswaehlen As Variant
Dim Uploadmappe As Workbook
Dim Zentralregister As Workbook
Set Zentralregister = ThisWorkbook
'Bildschirmflackern und Fehlermeldungen ausschalten
Application.ScreenUpdating = False 'Bildschirm flackern aus
Application.DisplayAlerts = False 'keine Fehlermeldungen während Upload
'Dialogbox zum Auswählen der Abteilungsregister:
Dateienauswaehlen = Application.GetOpenFilename(FileFilter:="Excel Files (*.xl*), *.xl*", _
Title:="Wählen Sie die Dateien für den Upload aus", _
MultiSelect:=True)
For i = LBound(Dateienauswaehlen) To UBound(Dateienauswaehlen)
Set Uploadmappe = Application.Workbooks.Open(Dateienauswaehlen(i))
Uploadmappe.Worksheets(1).Range("Upload1").Copy _
Zentralregister.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Uploadmappe.Close False
Next i
'Bildschirmflackern und Fehlermeldungen einschalten
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Objektvariablen leeren
Set Zentralregister = Nothing
Set Uploadmappe = Nothing
End Sub

cu
Chris
Anzeige
AW: Zusammenführen von Ranges in Workbook
01.04.2020 16:07:57
Ranges
Hallo Chris,
erst mal vielen herzlichen Dank für Deine Hilfe. Ich finde es wirklich unglaublich toll, wie hilfsbereit Du und das Forum seid. Ich bekomme für diese Zeile die Fehlermeldung "Syntaxfehler" oder "= erwartet":
Zentralregister.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Die Zielrange im Register ist als "Uploadbereich1" benannt. Das hatte ich oben vergesse und könnte wohl hilfreich sein, sorry!
Nochmal vielen Dank und viele Grüße
Jan
AW: Zusammenführen von Ranges in Workbook
01.04.2020 16:21:40
Ranges
Hi
Die beiden Zeilen gehören zusammen (der _ Strich ist quasi ein Zeilenumbruch).
Uploadmappe.Worksheets(1).Range("Upload1").Copy _
Zentralregister.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ist das gleiche wie....
Uploadmappe.Worksheets(1).Range("Upload1").Copy Zentralregister.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
So werden die Bereiche untereinander kopiert.
Deine Anforderung mit dem benannten Bereich geht nicht auf, wenn du MultiSelect willst. Es würde immer wieder der gleiche Bereich überschrieben.
Uploadmappe.Worksheets(1).Range("Upload1").Copy _
Zentralregister.Worksheets(1).Range("Uploadbereich1")
cu
Chris
Anzeige
AW: Zusammenführen von Ranges in Workbook
01.04.2020 17:08:46
Ranges
Hi Chris,
hab's raus.
vielen herzlichen Dank!
LG
Jan
AW: Zusammenführen von Ranges in Workbook
02.04.2020 10:29:21
Ranges
Hi,
vorab nochmal vielen Dank für die schnelle und tolle Hilfe.
Ich hätte noch ein kleines Refinement einzuarbeiten.
Und zwar gibt es in den einzelnen Upload-Dateien drei statische Informationen (Datum (D10), Bereich (D11), Verantwortlicher (D12)) , die ich jeweils in die einzelnen Zielzeile im zentral Register laden möchte (Datum in O, Bereich in C, Verantwortliche in D).
Kann man das in den bestehenden Code integrieren? Vielen lieben Dank!
Sub Registerupload2()
'Definitionen
Dim i As Long
Dim Dateienauswaehlen As Variant
Dim Uploadmappe As Workbook
Dim Zentralregister As Workbook
Set Zentralregister = ThisWorkbook
'Bildschirmflackern und Fehlermeldungen ausschalten
Application.ScreenUpdating = False 'Bildschirm flackern aus
Application.DisplayAlerts = False 'keine Fehlermeldungen während Upload
'Dialogbox zum Auswählen der Abteilungsregister:
Dateienauswaehlen = Application.GetOpenFilename(FileFilter:="Excel Files (*.xl*), *.xl*", _
Title:="Wählen Sie die Dateien für den Upload aus", _
MultiSelect:=True)
'Datenupload
For i = LBound(Dateienauswaehlen) To UBound(Dateienauswaehlen)
Set Uploadmappe = Application.Workbooks.Open(Dateienauswaehlen(i))
Uploadmappe.Worksheets(1).Range("Upload1").Copy _
Zentralregister.Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Offset(1, 0)
Uploadmappe.Close False
Next i
'Bildschirmflackern und Fehlermeldungen einschalten
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Objektvariablen leeren
Set Zentralregister = Nothing
Set Uploadmappe = Nothing
End Sub

Anzeige
AW: Zusammenführen von Ranges in Workbook
02.04.2020 10:59:32
Ranges
Hi Chris,
vorab nochmal vielen Dank für die schnelle und tolle Hilfe.
Ich hätte noch ein kleines Refinement einzuarbeiten.
Und zwar gibt es in den einzelnen Upload-Dateien drei statische Informationen (Datum (D10), Bereich (D11), Verantwortlicher (D12)) , die ich jeweils in die einzelnen Zielzeile im zentral Register laden möchte (Datum in O, Bereich in C, Verantwortliche in D).
Kann man das in den bestehenden Code integrieren? Vielen lieben Dank!
Sub Registerupload2()
'Definitionen
Dim i As Long
Dim Dateienauswaehlen As Variant
Dim Uploadmappe As Workbook
Dim Zentralregister As Workbook
Set Zentralregister = ThisWorkbook
'Bildschirmflackern und Fehlermeldungen ausschalten
Application.ScreenUpdating = False 'Bildschirm flackern aus
Application.DisplayAlerts = False 'keine Fehlermeldungen während Upload
'Dialogbox zum Auswählen der Abteilungsregister:
Dateienauswaehlen = Application.GetOpenFilename(FileFilter:="Excel Files (*.xl*), *.xl*", _
Title:="Wählen Sie die Dateien für den Upload aus", _
MultiSelect:=True)
'Datenupload
For i = LBound(Dateienauswaehlen) To UBound(Dateienauswaehlen)
Set Uploadmappe = Application.Workbooks.Open(Dateienauswaehlen(i))
Uploadmappe.Worksheets(1).Range("Upload1").Copy _
Zentralregister.Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Offset(1, 0)
Uploadmappe.Close False
Next i
'Bildschirmflackern und Fehlermeldungen einschalten
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Objektvariablen leeren
Set Zentralregister = Nothing
Set Uploadmappe = Nothing
End Sub

Anzeige
AW: Zusammenführen von Ranges in Workbook
02.04.2020 13:35:40
Ranges
Hi
Sub Registerupload2()
'Definitionen
Dim i As Long, lZ1 As Long, lZ2 As Long
Dim Dateienauswaehlen As Variant
Dim Uploadmappe As Workbook
Dim Zentralregister As Workbook
Set Zentralregister = ThisWorkbook
'Bildschirmflackern und Fehlermeldungen ausschalten
Application.ScreenUpdating = False 'Bildschirm flackern aus
Application.DisplayAlerts = False 'keine Fehlermeldungen während Upload
'Dialogbox zum Auswählen der Abteilungsregister:
Dateienauswaehlen = Application.GetOpenFilename(FileFilter:="Excel Files (*.xl*), *.xl*", _
Title:="Wählen Sie die Dateien für den Upload aus", _
MultiSelect:=True)
'Datenupload
With Zentralregister.Worksheets(1)
For i = LBound(Dateienauswaehlen) To UBound(Dateienauswaehlen)
Set Uploadmappe = Application.Workbooks.Open(Dateienauswaehlen(i))
lZ1 = .Cells(Rows.Count, 5).End(xlUp).Row + 1
Uploadmappe.Worksheets(1).Range("Upload1").Copy .Cells(lZ, 5)
lZ2 = .Cells(Rows.Count, 5).End(xlUp).Row
Uploadmappe.Worksheets(1).Range("D10").Copy .Range("O" & lZ1 & ":O" & lZ2)
Uploadmappe.Worksheets(1).Range("D11").Copy .Range("C" & lZ1 & ":C" & lZ2)
Uploadmappe.Worksheets(1).Range("D12").Copy .Range("D" & lZ1 & ":D" & lZ2)
Uploadmappe.Close False
Next i
End With
'Bildschirmflackern und Fehlermeldungen einschalten
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Objektvariablen leeren
Set Zentralregister = Nothing
Set Uploadmappe = Nothing
End Sub

cu
Chris
Anzeige
AW: Zusammenführen von Ranges in Workbook
02.04.2020 14:59:18
Ranges
Hallo Chris,
herzlichsten Dank!
Alles Gute und viele Grüße
Jan

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige