Excel File schließen
24.06.2015 10:29:24
Koenig
ich möchte gern ein Makro aus einer Excel Datei heraus starten welches eine Master Datei öffnent und danach mehrer Dateien hintereinander, um aus den vielen Dateien Informationen heraus zu kopieren und diese dann nacheinander in die Masterdatei zu kopieren. Die einzelnen Dateien möchte ich nach dem Vorgang ohne speichern schließen. Leider kann ich machen was ich will, die Meldung ob ich Speichern möchte kommt trotzdem. Hat vielleicht noch einer von den Profis eine Idee. Hier das Makro:
Sub Summary()
Call Summary_auslesen
End Sub
Public Function Summary_auslesen()
Dim Pfad As String
Dim Datei_1 As String
Dim Datei_2 As String
Dim Name_2 As String
Dim Pfad_datei As Workbook
Dim laenge As Integer
Dim Code As String
Dim Code2 As String
Dim a As Long
Dim i As Long
Dim f As Long
Dim varV As Variant
Dim e As Long
Dim wkb As Workbook
'Anzahl der VG Dateien
a = ThisWorkbook.Sheets("Auswahl").Cells(1, 6)
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Datei_2 = Cells(16, 3).Value 'Master ' Summary incl. Pfad
Workbooks.Open Filename:=Datei_2
'VG Dateien Ansteuern
For i = 1 To a
With ThisWorkbook.Worksheets("Auswahl")
Pfad = .Range("H1").Value 'Pfad für Guidline Dateien
Datei_1 = .Range("h" & i + 2).Value 'Guidline Dateien
Name_2 = .Cells(15, 3).Value 'Master ' Summary nur Name
Datei_2 = .Cells(16, 3).Value 'Master ' Summary incl. Pfad
End With
Set Pfad_datei = Workbooks.Open(Pfad & Datei_1)
For f = 1 To Worksheets.Count
Worksheets(f).Unprotect Password:="1893"
Next
'*****Inhalte Kopieren
Windows(Datei_1).Activate 'Guidline Land Datei
Sheets("Parameter").Select
Code = Cells(6, 2).Value 'Landnummer einlesen
laenge = Len(Code)
If laenge > 29 Then Code2 = Left(Code, 29) Else Code2 = Cells(6, 2).Value
Sheets("1_summary intern").Select 'Summary Blatt
Cells.Select
Selection.Copy
ScreenUpdating = False
Windows(Name_2).Activate 'Guideline Summary Datei
If WorkSheetExists(Code2) Then 'Suchen nach der Landdatei in Summary
Worksheets(Code2).Select
ActiveWindow.WindowState = xlMaximized
Range("A1").Select
ActiveSheet.Paste
Cells.Select
Range("A1").Activate
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Run "TM1RECALC"
Else
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Code2
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.Run "TM1RECALC"
End If
'hier sollte das Schließen ohne Speichern passieren
'Windows(Datei_1).Activate
Pfad_datei.Close savechanges:=False
Set Pfad_datei = Nothing
Windows(Name_2).Activate
ActiveWorkbook.save
Application.DisplayAlerts = True
Next i
Windows(Name_2).Activate
ActiveWorkbook.save
ActiveWorkbook.Close
ActiveWorkbook.save
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Function