online 1
gast (50)

/ Forum / Tabellenkalkulation

TabellenkalkulationTabellenkalkulation

Fragevon Nejos vom 15.02.2022, 09:14 Options

Lösung

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

Lö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.

Ähnliche Themen

Kopieren in neue Tabelle mittels formel
sturmflut  07.07.2009 - 145 Hits - 1 Antwort

Spalten einfügen in Excel mittels VBA
Franks  17.09.2009 - 350 Hits - 6 Antworten

Formeln in unterschiedlich langen Tabellen(VBA)
ghoul-xtc  29.09.2009 - 153 Hits - 2 Antworten

Excel VBA - Username einer geöffneten Datei
balumba  14.02.2010 - 390 Hits - 1 Antwort

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Version: supportware 1.9.150 / 10.06.2022, Startzeit:Mon Jan 26 09:21:55 2026