3 Worksheet in neues Workbook
28.07.2020 22:42:30
Richard
ich verzweifle an folgendem Problem. Die genutzten Excel-Versionen sind Excel 2010 bzw. 2019.
Ich will aus einem Template regelmäßig (monatlich) bestimmte Auswertungen (Worksheets) in eine neue Excel-Datei (Workbook) kopieren. Dabei sollen nur die Werte und Formate übernommen werden.
Aktuell sind es drei Auswertungen, die den CodeName Tabelle12, Tabelle13, Tabelle14 haben. Die internen Nummern (Index) sind 14, 15, 16. Es könnten aber auch noch weitere Tabellen mit dann anderen Indexnummern dazu kommen.
Die sichtbaren Tabellenbezeichnungen (z.B. Finanzanalyse lfd Periode) will ich nicht zur Adressierung nutzen, da diese durch einen unbedarften Nutzer versehentlich verändert werden könnten.
Ich bin das Thema so angegangen, dass ich zunächst die Tabellen in neue Worksheets kopiere, dann die Werte und Formate aus der Quelle übertrage und in ein neues Workbook kopiere. Schließlich will ich die neu angelegten Worksheets löschen und das neue Workbook schließen.
Das klappt mit einer Tabelle auch sehr gut. Es klappt auch mit drei Tabellen sogar fast perfekt, wenn ich die neu angelegten Worksheets nicht lösche (also Fette und kursive Zeile auskommentiert ist). Fast, weil in dem neuen Workbook die erste der drei Tabellen Formelbezüge auf die Quelltabelle hat, obwohl in dem angelegten Worksheet nur Zahlen enthalten sind.
Wenn ich die Worksheets löschen will, funktioniert dies mit dem zweiten und dem dritten Worksheet ohne Probleme. Das erste Worksheet bleibt jedoch erhalten und das Makro stoppt bei n =3 mit einem Index außerhalb des Bereiches.
Ich habe mir mit dem Debugger schon mehrfach alle Werte anzeigen lassen, finde aber den Fehler nicht, warum er beim letzten Löschvorgang die Tabelle nicht mehr findet. Überhaupt verstehe ich nicht, warum er zunächst die zweite und dann die dritte Tabelle löscht. Die Reihenfolge des Löschvorganges sollte gemäß der For-Next-Schleife bzw. des Array ja eigentlich anders sein
Irgendwas mache ich entweder beim Befüllen des Array oder auch bei der Adressierung der Tabellen falsch, komme aber nicht darauf
Kann mir jemand einen Hinweis geben, warum ich das eine Worksheet nicht löschen kann und warum _ plötzlich wieder Formelverknüpfungen vorhanden sind?
Sub ExportExcel()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wkbQuelle As Workbook
Dim wkbZiel As Workbook
Dim wksTab As Worksheet
Dim wksZiel As Worksheet
Dim strWksName As String
Dim lngAnzahlTab As Long
Dim arrAnalysen As Variant
Dim n As Integer
Set wkbQuelle = ThisWorkbook
Call Dateimanagement 'ermittelt Variablen für Dateinamenserstellugn
ReDim arrAnalysen(1 To 9)
' Array für Tabellenblätter befüllen
' 1-3 = Index-Nummer der auszugebenden Tabellen
' 2-6 = Name für neue Tabelle
' 7-9 = Index-Nummer der neu angelegte Worksheet
arrAnalysen(1) = 14 ' Tabelle Finanzanalyse Periode
arrAnalysen(2) = 15 ' Tabelle Finanzanalyse Verlauf
arrAnalysen(3) = 16 ' Tabelle Mehrjahresvergleich
' Namen der Register in Array Schreiben
arrAnalysen(4) = "Analyse lfd Periode"
arrAnalysen(5) = "Analyse Verlauf"
arrAnalysen(6) = "Mehrjahresvergleich"
For n = 1 To 3
'#### temporäres Blatt anlegen und Array hinschreiben
'Namen des temporären Blattes festlegen
strWksName = strJahr & " " & strMonat & " " & arrAnalysen(n + 3)
' Prüfen, ob Tabellenblatt (noch) existiert
For Each wksTab In ActiveWorkbook.Worksheets
If wksTab.Name = strWksName Then
wksTab.Delete
End If
Next
Worksheets.Add after:=Worksheets(Worksheets.Count) ' Neues Register anlegen an der _
letzten Position
ActiveSheet.Name = strWksName
Set wksZiel = ActiveSheet ' Eingefügtes Blatt als temporäres Blatt _
_
_
festlegen
arrAnalysen(n + 6) = ActiveSheet.Index ' Index-Nummer des angelegten Blattes speichern
'Debug.Print arrAnalysen(n + 6) & " " & ActiveSheet.Index & " " & ActiveSheet.Codename & " _
_
_
" & n + 6
'########## ohne Formeln kopieren
Sheets(arrAnalysen(n)).UsedRange.Copy
With wksZiel
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
.UsedRange.WrapText = False
.Columns.AutoFit
.Rows.AutoFit
End With
Next n
' temporäre Tabellen in neues Workbook übertragen und löschen
' Dateinamen Festlegen
strDateiN = strPfad & strOrdner & strJahr & "_" & strMonat & "_Finanzanalysen_" & strFirma & _
_
_
".xlsx"
lngAnzahlTab = Application.SheetsInNewWorkbook ' Auslesen Standardanzahl Register Excel
Application.SheetsInNewWorkbook = 1 'Standardanzahl Register auf 1 setzen
Set wkbZiel = Workbooks.Add
Application.SheetsInNewWorkbook = lngAnzahlTab ' Standardanzahl Register zurückschreiben
For n = 1 To 3
'Debug.Print n & " " & n + 6
'Debug.Print " Name " & wkbQuelle.Sheets(arrAnalysen(n)).Name & " CodeN:" & wkbQuelle. _
Sheets(arrAnalysen(n)).CodeName
wkbQuelle.Sheets(arrAnalysen(n)).Copy after:=wkbZiel.Sheets(wkbZiel.Sheets.Count)
Application.Goto reference:=Range("A1")
'Debug.Print arrAnalysen(n + 6) & " Name " & wkbQuelle.Sheets(arrAnalysen(n + 6)).Name & " _
_
_
CodeN:" & wkbQuelle.Sheets(arrAnalysen(n + 6)).CodeName
wkbQuelle.Sheets(arrAnalysen(n + 6)).Delete
Next n
wkbZiel.Sheets(1).Delete
' Speicherung
wkbZiel.Close savechanges:=True, Filename:=strDateiN
' Erledigungsvermerk in Tabelle Anleitung setzen
With Tabelle99
.Cells(16, 3).ClearContents
.Cells(16, 3).Value = "erledigt: " & Format(Now, "dd.mm.yyyy hh:mm:ss") & vbLf & _
strDateiN
End With
'Debug.Print "Ende: " & Now
MsgBox "Die Analyse wurde als Excel-Datei abgelegt unter: " & vbLf & vbLf & strDateiN, _
vbInformation, "Analysen per" & dtStichtag & " exportiert"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub