HILFE !!! Reiter mittels vba in eine neue Datei, aber als Wertopie ohne Formeln

Question

Moin Leute,
Ich möchte gerne aus einer Exceldatei 5 Reiter in eine neue Exceldatei kopieren, dies funktioniert mittels makro auch sehr gut, leider nur als Kopie und nicht als Wertkopie, ich habe diesen Code

Option Explicit
Public Sub CopyWks()
On Error GoTo DispFehler
Application.DisplayAlerts = False
Dim wbMappe As Workbook
Set wbMappe = Workbooks.Add
ThisWorkbook.Worksheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Copy Before:=wbMappe.Sheets(1)
wbMappe.Worksheets(Array(4, 5, 6)).Delete
DispFehler:
wbMappe.SaveAs "C:\Temp\DeinName.xls"
wbMappe.Close
Application.DisplayAlerts = True
Set wbMappe = Nothing
End Sub

Er funktioniert wie gesagt auch sehr gut nur leider muss ich um die Datei klein zu halten ein Wertkopie der Datein erstellen, wer kann mir helfen????

Gruß und danke für euro Hilfe Nejo´s

Answer 1

Hallo Oliver, danke für deine kompetente Hilfe, leider scheint noch ein Bug in dem Code zu sein, denn wenn man die Blattnamen eingegeben hat, schmiert das Teil mit einem Fehler ab...

Es muss auch nicht umbedingt sein, das man die Blattnamen in ein Feld eintragen muss, besser wäre es sogar, wenn ich im Code die Namen der Reiter ( 7 stk. ) eintragen könnte, denn diese bleiben immer unter diesem namen und die Datei wird nur als Paneldatei genutzt.

Möchte einfach nur, das auf Knopfdruck die 7 Reiter ( Die Namen der Reiter sollten im Code eingegeben werden, da sie ja immer gleich heissen ) in eine neue Datei tranveriert werden, der Name der Datei, in die sie kopiert werden ist auch immer der selbe. Das ganze sollte noch als Wertkopie geschehen, vielen Dank !!!!


Gruß Nejos

Answer 2

Hallo Nejos,

sorry, aber langsam komme ich mir verarsch..... vor. Wenn Du die Namen der Tabellenblätter fest angeben willst, warum nimmst Du denn nicht den Code aus AW3 und änderst die Blattnamen "Tabelle1", "Tabelle2" und "Tabelle3" in Deine Blattnamen? Bei weiteren Tabellenblättern hängst Du diese nur immer durch ein Komma getrennt hinten dran.

Wenn der Code aus AW8 nach dem Löschen der Zeile "Dim wbMappe As Workbook" einen Fehler bringt, dann schreibe mal, was dort für ein Fehler auftritt. Denn ohne den weiß man nicht, wie man Dir helfen soll. Das Makro jedenfalls hat bei mir in meiner Testumgebung funktioniert.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 3

Hallo Oliver,

sorry ich bin da nicht so bewandert, tut mir leid, dass du dich ein wenig auf den Schlips getreten fühlst, also ichw erde alles noch einmal neu formulieren, damit keiner sich ,, verarscht fühlt" und deine Hilfe mir zu gute kommen kann, also der Code
Option Explicit
Public Sub CopyWks()
On Error GoTo DispFehler
Application.DisplayAlerts = False
Dim wbMappe As Workbook
Set wbMappe = Workbooks.Add
ThisWorkbook.Worksheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Copy Before:=wbMappe.Sheets(1)
wbMappe.Worksheets(Array(4, 5, 6)).Delete
DispFehler:
wbMappe.SaveAs "C:\Temp\DeinName.xls"
wbMappe.Close
Application.DisplayAlerts = True
Set wbMappe = Nothing
End Sub

funktioniert nur soweit, dass nur 2 Tabellen kopiert werden, ich hätte gerne das 7 Reiter in eine neue Datei kopiert werden, der Name der Reiter sollte in den Quelltext geschrieben werden, bei dem Code den ich gepostet habe, ist es leider nciht möglich mehr als 3 Tabellen zu erstellen, oder die Tabellen heißen Tabelle 1 (1) Tabelle2 (2) und Tabelle3 was nicht sein sollte, die Reiter, welche in die neue Datei geschrieben werden sollen, sollten so heissen, wie die Reiter der Originaldatei.

Wäre nett wenn du mir trotzdem noch helfen würdest, weil ich merke, dass du echt Ahnung hast, wenn man besser beschreibt, was die Probleme sind ^^

Was kann der Fehler in dem Code sein, und wie erweitere ich diesen, so dass 7 Reiter kopiert werden, denn nur die Komma´s erweitern funktioniert nicht

Danke, danke Nejos

Answer 4

Hallo Nejos,

nachfolgender Code kopiert Dir 7 Tabellenblätter in eine neue Datei. Die Namen "Tabelle1", "Tabelle2" ....... "Tabelle7" in dem Makro musst Du gegen Deine Blattnamen tauschen.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub CopyWks()
On Error GoTo DispFehler
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(Array("Tabelle1", "Tabelle2", "Tabelle3", "Tabelle4", _
"Tabelle5", "Tabelle6", "Tabelle7")).Copy
DispFehler:
ActiveWorkbook.SaveAs "C:\Temp\DeinName.xls"
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub


MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 5

Hi Oliver,
du bist echt klasse, funktioniert super der Code ohne Fehler, einfach super, nun wäre noch ein kleine Sache, ich bräuchte das ganze als Wertkopie, also der Code + Wertkopie und ich wäre glücklich ^^ Hast du ne Idee???


Nochmals vielen Dank Gruß Nejos

Answer 6

Hallo Nejo,

sorry, hatte ich gnz vergessen. ich hatt nur den Code aus AW13 genommen und entsprechend abgeändert, ohne an die Bereinigung der Formeln zu denken. Nachfolgend nun das richtige Makro.

Option Explicit

Sub CopyWks()
Dim intSheets As Integer
On Error GoTo DispFehler
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
ThisWorkbook.Worksheets(Array("Tabelle1", "Tabelle2", "Tabelle3", "Tabelle4", _
"Tabelle5", "Tabelle6", "Tabelle7")).Copy
For intSheets = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(intSheets).Cells.Copy
ActiveWorkbook.Sheets(intSheets).Range("A1").PasteSpecial Paste:=xlPasteValues
Next
DispFehler:
ActiveWorkbook.SaveAs "C:\Temp\DeinName.xls"
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Subb
MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 7

Hallo Oliver,

Super !!!! Der Code funktioniert 1 a, leider habe ich in jeder Tabelle einen Code (=VERKETTEN("Current Month ";TEIL(ZELLE("Dateiname"); SUCHEN("["; ZELLE("Dateiname"))+37; SUCHEN("]"; ZELLE("Dateiname"))- SUCHEN("["; ZELLE("Dateiname")) -48)) der sich das Datum aus dem Dateinamen zieht, sobald allerdings eine neue Datei geöffnet wird, funktioniert das ganze nicht mehr und es steht nur #Wert im Feld, leider auch in der Datei mit den neu kopierten Reitern. Gibt es da ne Möglichkeit das ganze irgendwie möglich zu machen??? Vllt das sich das Datum irgendwie vorher geholt wird??

DANKE NOCHMAL AN EUCH ALLE FÜR DIE HILFE, BESONDERS OLIVER !!!

Answer 8

Hallo Nejo,

wo steht wann der Fehler in der Zelle? Gib mal ein Beispiel des Dateinamens.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 9

Das mit dem Fehler ist gelöst, dieser tritt nämlich auf wenn man auf den Dateinamen verlinkt und noch ne zweite excel datei öffnet, dann weiß er nicht welchen er nehmen soll, der Code ist echt Spitze, gibt es auch die möglichkeit ein Dialogfeld auszugeben wo steht:,, Die Datei (Name ( ist immer gleich weil statisch )wurde in dem und dem Pfad gespeichert") ist das möglich`????


Bin glaube ich kurz davor die Aufgabe zuende zu bringen, vielen dank für deine Hilfe!

Answer 10

Hallo Nejo,

dann sieht das Makro wie folgt aus:

Option Explicit

Sub CopyWks()
Dim intSheets As Integer
On Error GoTo DispFehler
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
ThisWorkbook.Worksheets(Array("Tabelle1", "Tabelle2", "Tabelle3", "Tabelle4", _
"Tabelle5", "Tabelle6", "Tabelle7")).Copy
For intSheets = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(intSheets).Cells.Copy
ActiveWorkbook.Sheets(intSheets).Range("A1").PasteSpecial Paste:=xlPasteValues
Next
DispFehler:
ActiveWorkbook.SaveAs "C:\Temp\DeinName.xls"
ActiveWorkbook.Close
Application.DisplayAlerts = True
MsgBox "Die Datei ""DeinName.xls"" wurde im Verzeichnis ""C:\Temp\"" abgelegt", _
vbInformation, "Meldung..."
End SubbMfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]