Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1488to1492
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

Tabellenabschnitt aus zweiter Excel Datei kopieren

Tabellenabschnitt aus zweiter Excel Datei kopieren
26.04.2016 15:44:20
dani_boy
Hallo Leute,
ich habe nochmal eine Frage. In einer zentralen Übersichtsdatei sollen Tabellenausschnitte aus mehreren Excel Dateien (einzelne Regionen Deutschland) zusammengeführt werden. Zuvor löste ich das in einer Datei d.h. ein Übersichtssheet und mehrere Sheets für die einzelnen Regionen. Nun will ich dies aber ändern. Jede Region soll nun ein einzelnes Worksheet (extra Datei) sein und die Übersichtsdatei zieht die entsprechenden Informationen aus den einzelnen Dateien. Nun fällt es mir jedoch schwer den Code so umzuschreiben das dies funktioniert.
Weiterhin liegen alle Dateien in einem Ordner und der Ordner wird immer als ganzes verschoben. Deswegen würde ich das gerne so umsetzen, dass es keine konkreten Verzeichnisse angegeben werden müssen sondern alles auf diesen gemeinsamen Ordner verlinkt.
Folgende Lösung habe ich bisher. Hier wird jedoch nocht mit einem konkreten Verzeichnis gearbeitet und weiterhin funktioniert das ansprechen der Dateienen noch nicht.

Option Explicit
Sub Bayern()
Rem: Variablen deklarieren
Dim wsZiel As Worksheet
Dim wsQuelle As Worksheet
Dim lastCell As Long, lastColumn As Integer
Rem: Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
'Zielblatt = aktive Datei, aktives Blatt
Set wsZiel = ActiveWorkbook.ActiveSheet
'Quellblatt = Datei, Blatt 1
Set wsQuelle = Workbooks.Open(Filename:="Verzeichnis\Bayern.xlsx").Worksheets(1)
Rem: letzte beschriebene Zeile in Tabellenblatt "Tabelle1" in Spalte A ermitteln
Rem: und in Variable "lastCell" schreiben
Rem: Stehen die Kundennummern in einer anderen Spalte, die Spaltenbezeichnung A
Rem: in der Range("A65536")- Anweisung ändern
lastCell = Workbooks("Bayern.xlsx").Worksheets("Bayern").Range("E65536").End(xlUp).Row
Rem: Den Bereich A1 bis letzte beschriebene Zelle und letzte beschriebene Zeile
Rem: (Bereichsende setzt sich aus den Variablen "lastColumn" und "lastCell" zusammen) kopieren   _
_
und...
wsQuelle.Range(Cells(6, 1), Cells(lastCell, 10)).Copy
'Quelle schließen
wsQuelle.Parent.Close
Set wsQuelle = Nothing
Set wsZiel = Nothing
Rem: Einfügen in das Übersichtssheet aus der Übersichtsdatei
lastCell = Sheets("Übersicht").Range("B65536").End(xlUp).Row
Sheets("Übersicht").Cells(Sheets("Übersicht").Range("A65536").End(xlUp).Offset(lastCell - 1). _
Row, 1) _
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Übersicht").Cells(Sheets("Übersicht").Range("A65536").End(xlUp).Offset(lastCell - 1). _
Row, 1) _
.PasteSpecial Paste:=xlPasteValues
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Tabellenabschnitt aus zweiter Excel Datei kopieren
27.04.2016 12:44:51
Piet
Hallo dani_boy
ich sehe das keiner an den Thread heran geht. Muss in mir erst mal in Ruhe ansehen.
In deinem Code sind so einige Ungereimtheiten. Hat der überhaupt jemals gelaufen?
Vor allem diese Adressierung bereitet mir Bauchschmerzen:
Sheets("Übersicht").Cells(Sheets("Übersicht").Range("A65536").End(xlUp).Offset(lastCell - 1). _
Row, 1)
1.) das Blatt Übersicht wird doppelt benannt! Muss ich mal bei mir testen was dann passiert?
2.) du sucht LastCell in Spalte B, dann LastCell in Spalte A, und macht einen Offset mit LastCell?
Da ist mir so einiges schleierhaft wie das ablaufen soll?
Sage mir lieber mal was genau du kopieren willst? Ob in Spalte A oder B die LasdtCell relevant ist und warum?
Dann können wir gemeinsam mal schauen das wir den Code ans laufen bekommen.
mfg Piet

Anzeige
AW: Tabellenabschnitt aus zweiter Excel Datei kopieren
27.04.2016 15:25:12
Piet
Hi
habe mir die Sache angesehen und festgestellt das ich unüberlegt geantwortet habe!
Sheets("Übersicht") ist korrekt, das habe es im ersten Augenblick falsch verstanden.
Zu deiner Frage:
die Antwort liegt in der Frage selbst! - Set wsZiel = ActiveWorkbook.ActiveSheet
Hier setzt du zuerst eine Ziel Tabelle, ein Aktives Blatt, löschst sie aber wieder vor
dem kopieren, und kopierst hier in das Übersicht Blatt, statt in die Ziel Tabelle.
Noch ein bisschen unklar ist mir der Offset über LastCell? Wie auch die Frage lautet,
ob du im Aktiven Blatt mit End(xlUp) arbeiten musst, wenn die Tabelle noch leer ist?
Dann kann man doch direkt ab Zeile A2 die Daten einfügen.
Statt 2mal kopieren, einmal NumberFormat und Werte kann man den Kombibefehl nehmen.
Anbei ein Versuch von mir den Code zu lösen. Set wsZiel = Nothing muss nach unten!
mfg Piet
Option Explicit
Sub Bayern()
Rem: Variablen deklarieren
Dim wsZiel As Worksheet
Dim wsQuelle As Worksheet
Dim lastCell As Long, lastColumn As Integer
Rem: Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
'Zielblatt = aktive Datei, aktives Blatt
Set wsZiel = ActiveWorkbook.ActiveSheet
'Quellblatt = Datei, Blatt 1
Set wsQuelle = Workbooks.Open(Filename:="Verzeichnis\Bayern.xlsx").Worksheets(1)
Rem: letzte beschriebene Zeile in Tabellenblatt "Tabelle1" in Spalte A ermitteln
Rem: und in Variable "lastCell" schreiben
Rem: Stehen die Kundennummern in einer anderen Spalte, die Spaltenbezeichnung A
Rem: in der Range("A65536")- Anweisung ändern
lastCell = Workbooks("Bayern.xlsx").Worksheets("Bayern").Range("E65536").End(xlUp).Row
Rem: Den Bereich A1 bis letzte beschriebene Zelle und letzte beschriebene Zeile
Rem: (Bereichsende setzt sich aus den Variablen "lastColumn" und "lastCell" zusammen) kopieren  _
und...
wsQuelle.Range(Cells(6, 1), Cells(lastCell, 10)).Copy
'Quelle schließen
wsQuelle.Parent.Close
Set wsQuelle = Nothing
Rem: Einfügen in das Übersichtssheet aus der Übersichtsdatei
lastCell = wsZiel.Range("B65536").End(xlUp).Row
'PasteSpecial mit NumberFormat kombiniert
'**  Code ggf. gegen neue Version austauschen !!
wsZiel.Cells(wsZiel.Range("A65536").End(xlUp).Offset(lastCell - 1).Row, 1) _
.PasteSpecial xlPasteValuesAndNumberFormats, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Set wsZiel = Nothing
End Sub
Sub neue_Version_SpalteB()
'neue Version:  mit LastCell, bezogen auf Spalte B
'**  setxt voraus das Spalte B immer gefüllt sein muss !!
wsZiel.Range("B65536").End(xlUp).Offset(1, -1).PasteSpecial _
xlPasteValuesAndNumberFormats, SkipBlanks:=False, Transpose:=False
End Sub

Anzeige
AW: geschlossen oWt
02.05.2016 20:27:50
Piet
,,,

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige