HILFE !!! Reiter mittels vba in eine neue Datei, aber als Wertopie ohne Formeln
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
Antwort schreiben
Antwort 1 von coros vom 15.02.2022, 09:37 Options
Hallo Nejo,
was bitte verstehst Du unter "Wertkopie"? Erklär bitte etwas genauer, was Du möchtest.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 2 von rainberg vom 15.02.2022, 09:47 Options
Hallo Oliver,
es sollen nur die Zellwerte, keine Formeln kopiert (eingefügt) werden
Gruss
Rainer
Antwort 3 von coros vom 15.02.2022, 09:50 Options
Hallo Nejos, hallo Rainer!
Wenn es sich so verhält, wie Reiner es geschrieben hat, dann sollte es mit nachfolgendem Makro gehen.
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
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
Dim intSheets As Integer
For intSheets = 1 To wbMappe.Sheets.Count
wbMappe.Sheets(intSheets).Cells.Copy
wbMappe.Sheets(intSheets).Range("A1").PasteSpecial Paste:=xlPasteValues
Next
DispFehler:
wbMappe.SaveAs "C:\Temp\DeinName.xls"
wbMappe.Close
Application.DisplayAlerts = True
Set wbMappe = Nothing
End Sub
Hier werden nach dem Kopieren alle Formeln in allen Tabellenblättern der neuen Datei gegen die Werte ausgetauscht.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 4 von Nejos vom 15.02.2022, 19:05 Options
Danke, der Quelltext funktioniert soweit, nur das die Reiter dann Tabelle 1 (1), Tabelle (2) und Tabelle (3) heissen , sie sollten schon so heissen wie die original Reiter der Datei, von der sie kopiert werden, kann mir jemand helfen???
Gruß Nejos
Antwort 5 von coros vom 15.02.2022, 19:26 Options
Hallo Nejos,
hast Du Dir Deine 1. Frage mal angesehen? Was stehen dort für Tabellenblattnamen? Richtig, "Tabelle1", "Tabelle2" und "Tabelle3". Und danach habe ich den Code ergänzt.
Das die Tabellenblätter anders heißen hast Du nirgends erwähnt. Wie lauten denn die Blattnamen? Oder an welcher Stelle stehen die Blätter. Ohne diese Infos kann man Dir nicht helfen.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 6 von nejos vom 15.02.2022, 19:52 Options
Sagen wir die Reiter heissen Instantsuppen, ET 800g etc. also diverse unterschiedliche Namen, ist das nicht irgendwie möglich hinzukriegen? Vll wenn ich nen Code hätte wo ich die Namen der Reiter eintragen kann...
ausserdem müssten mehr als 3 reiter kopiert werden, vielen Dank für deine Hilfe
Gruß Nejos
Antwort 7 von coros vom 16.02.2022, 07:42 Options
Hallo Nejos,
nachfolgend Dein Makro so abgeändert, dass Du den Namen der zu kopierenden Blätter eingeben kannst.
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
Public Sub CopyWks()
Dim wbMappe As Workbook
Dim strDruckarray()
Dim intMeldung As Integer
Dim wbMappe As Workbook
Dim intZähler As Integer
Dim strEingabe As String
Dim intSheetIndex As Integer
Dim bolSheetVorhanden As Boolean
Dim intSheets As Integer
On Error GoTo DispFehler
Application.DisplayAlerts = False
'------------------------------------------------------------------------------
intZähler = 1
ReDim strDruckarray(1 To intZähler)
Anfang:
'------------------------------------------------------------------------------
'Schritt 1: Eingabe des Blattnamen
strEingabe = InputBox("Bitte Blattname eintragen", Default:=strEingabe)
'------------------------------------------------------------------------------
'Schritt 2: Prüfen ob eingegebenes Tabellenblatt in Datei vorhanden ist
bolSheetVorhanden = False
For intSheetIndex = 1 To Sheets.Count
If Sheets(intSheetIndex).Name = strEingabe Then
bolSheetVorhanden = True
Exit For
End If
Next intSheetIndex
'------------------------------------------------------------------------------
'Schritt 3: Blattnamen in Array eintragen, wenn vorhanden, wenn nicht Bildschirmmeldung
If bolSheetVorhanden = True Then
strDruckarray(intZähler) = strEingabe
Else
MsgBox "Das angegebene Tabellenblatt existiert in dieser Datei nicht. Bitte " _
& "ändern Sie den Blattnamen.", vbCritical, "falsche Eingabe..."
GoTo Anfang
End If
'------------------------------------------------------------------------------
'Schritt 4: Abfrage, ob ein weiteres Tabellenblatt eingegeben werden soll
intMeldung = MsgBox("Sollen weitere Blattnamen eingetragen werden?", _
vbYesNo + vbQuestion, "Blattnameneingabe...")
If intMeldung = 6 Then
intZähler = intZähler + 1
ReDim Preserve strDruckarray(1 To intZähler)
GoTo Anfang
End If
'------------------------------------------------------------------------------
'Schritt 5: Blätter in neue Datei kopieren
Set wbMappe = Workbooks.Add
ThisWorkbook.Worksheets(strDruckarray).Copy
'------------------------------------------------------------------------------
'Schritt 6: Daten kopieren und nur Werte in Blatt zurückschreiben
For intSheets = 1 To wbMappe.Sheets.Count
wbMappe.Sheets(intSheets).Cells.Copy
wbMappe.Sheets(intSheets).Range("A1").PasteSpecial Paste:=xlPasteValues
Next
DispFehler:
wbMappe.SaveAs "C:\Temp\DeinName.xls"
wbMappe.Close
Application.DisplayAlerts = True
Set wbMappe = Nothing
End Subb
In Schritt 1 erfolgt die Eingabe des Blattnamens.
In Schritt 2 wird geprüft, ob der eingegebene Blattname in der Datei existiert.
Gibt es das Blatt, dann wird in Schritt 3 der eingegebene Blattname in ein Array geschrieben. Wenn nicht, erscheint eine Bildschirmmeldung, dass der Blattname geändert werden muss.
In Schritt 4 wird abgefragt, ob weitere Tabellenblattnamen eingegeben werden soll. Wenn ja, dann wird wieder mit Schritt 1 begonnen.
Schritt 5 kopiert alle angegebenen Tabellenblätter in eine neue Datei.
Bei Schritt 6 werden dann wieder alle Formeln gegen Werte ausgetauscht.
Ich hoffe, Du meintest das so?
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 8 von coros vom 16.02.2022, 08:01 Options
Hi,
ich nochmal. Nachfolgend das Makro nochmal mit einer kleiner Korrektur. Funktionsweise ist aber genau wie in AW7 bereits beschrieben.
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
Public Sub CopyWks()
Dim wbMappe As Workbook
Dim strDruckarray()
Dim intMeldung As Integer
Dim wbMappe As Workbook
Dim intZähler As Integer
Dim strEingabe As String
Dim intSheetIndex As Integer
Dim bolSheetVorhanden As Boolean
Dim intSheets As Integer
On Error GoTo DispFehler
Application.DisplayAlerts = False
'------------------------------------------------------------------------------
intZähler = 1
ReDim strDruckarray(1 To intZähler)
Anfang:
'------------------------------------------------------------------------------
'Schritt 1: Eingabe des Blattnamen
strEingabe = InputBox("Bitte Blattname eintragen", Default:=strEingabe)
'------------------------------------------------------------------------------
'Schritt 2: Prüfen ob eingegebenes Tabellenblatt in Datei vorhanden ist
bolSheetVorhanden = False
For intSheetIndex = 1 To Sheets.Count
If Sheets(intSheetIndex).Name = strEingabe Then
bolSheetVorhanden = True
Exit For
End If
Next intSheetIndex
'------------------------------------------------------------------------------
'Schritt 3: Blattnamen in Array eintragen, wenn vorhanden, wenn nicht Bildschirmmeldung
If bolSheetVorhanden = True Then
strDruckarray(intZähler) = strEingabe
Else
MsgBox "Das angegebene Tabellenblatt existiert in dieser Datei nicht. Bitte " _
& "ändern Sie den Blattnamen.", vbCritical, "falsche Eingabe..."
GoTo Anfang
End If
'------------------------------------------------------------------------------
'Schritt 4: Abfrage, ob ein weiteres Tabellenblatt eingegeben werden soll
intMeldung = MsgBox("Sollen weitere Blattnamen eingetragen werden?", _
vbYesNo + vbQuestion, "Blattnameneingabe...")
If intMeldung = 6 Then
intZähler = intZähler + 1
ReDim Preserve strDruckarray(1 To intZähler)
GoTo Anfang
End If
'------------------------------------------------------------------------------
'Schritt 5: Blätter in neue Datei kopieren
ThisWorkbook.Worksheets(strDruckarray).Copy
'------------------------------------------------------------------------------
'Schritt 6: Daten kopieren und nur Werte in Blatt zurückschreiben
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
Set wbMappe = Nothing
End Sub
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 9 von Nejos vom 16.02.2022, 17:06 Options
Sieht schon sehr passend aus, nur leider kriege ich den Fehler Mehrfachdeklarationen im aktuellen Gültigkeitsbereich...was mache ich falsch? Ich habe einen Button und dort den Code eingetragen, irgendjemand ne idee???
Danke für eure Hilfe
Antwort 10 von coros vom 16.02.2022, 17:11 Options
Hallo,
lösche in dem Makro die Zeilen
Dim wbMappe As Workbookk
heraus, dann sollte der Fehler nicht mehr auftreten.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 11 von Nejos vom 16.02.2022, 17:31 Options
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
Antwort 12 von coros vom 16.02.2022, 18:20 Options
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
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 13 von nejos vom 17.02.2022, 11:48 Options
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
Antwort 14 von coros vom 17.02.2022, 11:59 Options
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
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 15 von Nejos vom 17.02.2022, 12:53 Options
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
Antwort 16 von coros vom 17.02.2022, 13:19 Options
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
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 17 von Nejos vom 17.02.2022, 13:49 Options
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 !!!
Antwort 18 von coros vom 17.02.2022, 14:03 Options
Hallo Nejo,
wo steht wann der Fehler in der Zelle? Gib mal ein Beispiel des Dateinamens.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 19 von nejos vom 17.02.2022, 16:50 Options
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!
Antwort 20 von coros vom 17.02.2022, 19:50 OptionsLösung
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 Subb
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.