Versuch einer Automatisierung

Hallo,
Ich habe eine Excel Datei mit 4 Blättern. 2 Blätter davon haben Daten in Rohform enthalten, die beiden anderen sind mit Verweisen auf diese Blätter zur Darstellung gedacht. Meine bisher aufwenige händische Arbeit liegt darin, jeweils die beiden "fertigen" Blätter von Hand in eine neue Excel-Datei zu kopieren (mit rechter Maustaste aufs Tabellenblatt und dann kopieren). Dort muss ich dann die ganzen Daten kopieren und mit "Inhalte einfügen- Werte" die Bezüge löschen. Anschließend werden in der anderen Datei in den Rohdaten neue Zahlen eingespielt, und das Spiel beginnt von vorne (ich hoffe das war nachvollziehbar)
Mein Ziel ist jetzt:
1. automatisches kopieren der beiden fertigen Tabellenblätter in eine neue bzw. bestehende andere Excel-Datei
2. die Bezüge aus den Zellen zu löschen (bisher über Inhalte einfügen-Werte)
3. wenn möglich den Tabellenblättern automatisch Namen zu vergeben welche in der Zelle A1 stehen
Wäre sehr froh wenn mir hier jemand helfen könnte. Vielen Dank!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Tobias,
kleine Modifikation eines anderen Problems von heute ergibt folgendes Makro für den Export. Die Namen der beiden zu exportierenden Blätter muss du noch anpassen.
Gruß
Franz


Sub ExportFertige()
'Fertige Tabellenblätter exportieren
Dim wbThis As Workbook, wbExport As Workbook, I As Integer, strFertig, DatName, Auswahl
Dim wksThis As Worksheet, wksExport As Worksheet, Bereich As Range
Set wbThis = ThisWorkbook
strFertig = Array("Fertig1", "Fertig2") 'Namen der zu kopierenden Blätter
Auswahl = MsgBox("Kopien in existierender Datei einfügen?", vbYesNo + vbQuestion, "Daten exportieren")
If Auswahl = vbYes Then
DatName = Application.GetOpenFilename(FileFilter:="Excel(*.xls,*.xls", Title:="Bitte Datei auswählen")
If DatName = False Then Exit Sub
Set wbExport = Workbooks.Open(Filename:=DatName)
Else
'Neue Mappe mit Tabellen anlegen
Set wbExport = Application.Workbooks.Add(xlWBATWorksheet)
End If
'Daten und Formate der fertigen Blätter übertragen
For I = 0 To UBound(strFertig)
Set wksThis = wbThis.Worksheets(strFertig(I))
wksThis.Copy After:=wbExport.Sheets(wbExport.Sheets.Count)
Set wksExport = ActiveSheet
'Tabellennamen für Export-Blatt übernehemn
wksExport.Name = wksThis.Range("A1").Text
'Verknüpfungen durch Werte kopieren entfernen
wksExport.UsedRange.Value = wksExport.UsedRange.Value
Next
'Datei mit exportierten Blättern speichern
If Auswahl = vbYes Then
wbExport.Save
Else
wbExport.Activate
Application.DisplayAlerts = False
'Leerblatt in neuer Datei wieder löschen
wbExport.Sheets(1).Delete
Application.DisplayAlerts = True
'Neue Datei speichern
Application.Dialogs(xlDialogSaveAs).Show
End If
End Sub

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread