Tabellenblätter aus ext. Datei kopieren

Forumthread: Tabellenblätter aus ext. Datei kopieren

20.03.2009 09:18:22

Mandy

Hi,
such dringend Hilfe. Ich suche ein Makro, mit dem ich aus Excel heraus den ÖFFNEN-Dialog starten kann, eine externe Excel Tabelle auswählen kann und dann alle darin befindlichen Tabellenblätter in mein Sheet laden kann.
Muss dazu sagen, meine Tabelleblätter, die ich kopieren will, enthalten viele Formeln, die ich aber in meiner Zieldatei (Datei mit diesem Makro) nicht haben will. Wenns geht, will ich nur die Inhalte der Zellen. Also, so, wie wenn ich Kopieren machen und dann WERTE EINFÜGEN, dass ich nur den reinen Text habe.
Gibt es dafür vielleicht ein gesondertes Verfahren ?
Falls es nicht geht, wäre mir auch schon geholfen, wenn ich die Tabellenblätter in meiner Zielatei hätte.
Vielleicht kann ich es dann manuell auf Werte umsetzen.
Hat dazu vielleicht jemand ein Beispiel parat ?
Wäre echt nett.
Danke schon mal fürs lesen.
Gruss
Mandy

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Tabellenblätter aus ext. Datei kopieren

20.03.2009 10:04:08

fcs

Hallo Handy,
hier ein Beispiel.
Gruß
Franz


Sub TabellenblaeterHolen()
'Kopiert alle Blätter (nur Werte) aus Quellmappe in die Zielmappe
Dim wbZiel As Workbook
Dim wbQuelle As Workbook
Dim varWB_Quelle, wks_Quelle
'ZielArbeitsmappe festlegen
Set wbZiel = ActiveWorkbook
'Quelldatei auswählen
varWB_Quelle = Application.GetOpenFilename(Filefilter:="Excel(*.xl*),*.xl*", _
Title:="Bitte Datei mit zu importierenden Blättern auswählen")
If varWB_Quelle  False Then
Set wbQuelle = Application.Workbooks.Open(Filename:=varWB_Quelle, ReadOnly:=True)
'in allen Blättern der Quelle die Formeln durch Werte ersetzen
For Each wks_Quelle In wbQuelle.Worksheets
wks_Quelle.UsedRange.Copy
wks_Quelle.UsedRange.PasteSpecial Paste:=xlPasteValues
Next
Application.CutCopyMode = False
'Blätter kopieren
wbQuelle.Sheets.Copy after:=wbZiel.Sheets(wbZiel.Sheets.Count)
'Quelle wieder schließen ohne speichern
wbQuelle.Close savechanges:=False
End If
End Sub

Fehlermeldung

20.03.2009 10:53:59

Mandy

Hallo Franz,
vielen Dank. Bekomme beim einlesen eine Fehlermldung. Hat wahrscheinlich aber nichts mit Deinem Makro zu tun. Ich kann blos mit der Fehlermeldung nichts anfangen. Habe sowas noch nie gesehen.
Sagt Dir das was:
https://www.herber.de/bbs/user/60491.xls
Gruss Mandy

AW: Fehlermeldung

20.03.2009 15:16:53

fcs

Hallo mandy,
in der Datei aus der du die Tabellenblätter Einfügen willst sind für Tabellenbereich Namen festgelegt.
Der gleiche Name existiert auch in der Datei, in der du die Blätter einfügen willst. Das löst dann beim Einfügen die Meldung aus.
Wenn du die Bereichsnamen in den eingefügten Blättern nicht mehr benötigst, dann kannst du die Meldung einfach mit "Ja" bestätiguen
Falls es sehr viele Meldungen dieser Art gibt, dann ist es am Besten die Namen vor dem Kopieren zu löschen.
Hier die Makro-Anpassung, die die Namen in der Quelle lösch.
Gruß
Franz


Sub TabellenblaeterHolen()
'Kopiert alle Tabellenblätter (nur Werte) aus Quellmappe in die Zielmappe
Dim wbZiel As Workbook
Dim wbQuelle As Workbook, objNamenQ As Name
Dim varWB_Quelle, wks_Quelle
On Error GoTo Fehler
'ZielArbeitsmappe festlegen
Set wbZiel = ActiveWorkbook
'Quelldatei auswählen
varWB_Quelle = Application.GetOpenFilename(Filefilter:="Excel(*.xl*),*.xl*", _
Title:="Bitte Datei mit zu importierenden Blättern auswählen")
If varWB_Quelle  False Then
Set wbQuelle = Application.Workbooks.Open(Filename:=varWB_Quelle, ReadOnly:=True)
'in allen Blättern der Quelle die Formeln durch Werte ersetzen
For Each wks_Quelle In wbQuelle.Worksheets
wks_Quelle.UsedRange.Copy
wks_Quelle.UsedRange.PasteSpecial Paste:=xlPasteValues
Next
'Namen löschen
For Each objNamenQ In wbQuelle.Names
With objNamenQ
If InStr(1, .Name, "Print") > 0 Then
'Bereiche mit Druckeinstellungen nicht löschen
Else
.Delete
End If
End With
Next
Application.CutCopyMode = False
'Blätter kopieren
wbQuelle.Sheets.Copy after:=wbZiel.Sheets(wbZiel.Sheets.Count)
'Quelle wieder schließen ohne speichern
wbQuelle.Close savechanges:=False
End If
Fehler:
With Err
If .Number  0 Then
Select Case .Number
Case 9999999
Case Else
MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
End Select
End If
End With
End Sub

Danke.....

20.03.2009 20:02:34

Mandy

Hallo Franz,
Spitze, vielen Dank. Du hattest Recht, jetzt gehts. SUPI.
Gruss Mandy

Beliebteste Forumthreads (12 Monate)

Tabellenblätter aus ext. Datei kopieren

Forumthread: Tabellenblätter aus ext. Datei kopieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Tabellenblätter aus ext. Datei kopieren

Forumthread: Tabellenblätter aus ext. Datei kopieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread