Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
1708to1712
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

Mehrere Tabellen aus Datei kopieren

Mehrere Tabellen aus Datei kopieren
21.08.2019 10:46:02
Änna
Hallo ihr Lieben,
ich möchte folgendes Skript umwandeln, sodass mehrere Tabellenblätter aus einer Datei in die offene Datei kopiert werden.
___________________________________________________________________________________
Option Explicit

Sub cmdimport_Click()
Dim QWB As Workbook, ZWB As Workbook
Dim ordner As Variant
ordner = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*, ,*.*")          ' _
Wenn die Datei erst geöffnet werden muss
'   vFileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)
Set QWB = Workbooks.Open(ordner)          ' Quelle, aus der die Tabelle kopiert werden soll
Set ZWB = ThisWorkbook                  ' Ziel, Workbook mit diesem Makro
Dim QWS As Worksheet, ZWS As Worksheet
Set QWS = QWB.Tabelle2 ' Quelle
Set ZWS = ZWB.Worksheets("Tabelle1")    ' Ziel
QWS.Copy after:=ZWS                 ' oder before
QWB.Close          ' Wenn die Datei wieder geschlossen werden soll
End Sub

_____________________________________________________________________________
Optimal wäre es, würde man eine Schleife einbauen, sodass alle Tabellenblätter der Datei außer die mit den Namen "Info","Input","Cockpit" und "Plants". Wenn das jedoch nicht geht (ich kenne mich wenig mit VBA aus), dann würde ich alle Tabellenblätter benennen, die kopiert werden sollen.
Kann mir dabei jemand weiterhelfen?
Vielen Dank und beste Grüße
Änna

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrere Tabellen aus Datei kopieren
21.08.2019 11:54:48
Daniel
Hallo Änna,
als Ansatz - anstatt der Zeile QWS.Copy
For Each QWS In QWB.Worksheets
Select Case QWS.Name
Case "Info", "Input", "Cockpit", "Plants"
'nix
Case Else
ws.Copy after:=ZWS
End Select
Next QWS
QWB.Close
Probier mal.
Gruß
Daniel

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige