habe ein makro (mit hilfe von euch) erstellt. nun mein problem ist, das makro läuft und am ende wird das ganze tabellenblatt
ausgeblendet (ohne das ich was geändert habe). durch die
menü funktion "fenster einblenden" kann ich es wieder einschalten
sehe dann aber dass das makro seine arbeit nicht oder nur teilweise ausgeführt hat.
hat jemand eine idee was das sein könnte ?
-- makro --------
Option Explicit
Public Sub Werte_zusammentragen()
Dim appOffice As Object
Dim Service As Byte, KW As Byte
Dim Dienstleistung As String
On Error Resume Next
'Application.ScreenUpdating = False
For Service = 1 To 5
Select Case Service
Case 1
Dienstleistung = "Bloomberg"
For KW = 1 To 52
Set appOffice = GetObject("D:\Verfügbarkeit\" & Dienstleistung & "\KW-" & Format(KW, "00") & "-" & Dienstleistung & ".xls")
With appOffice
Cells(Cells(65536, Service).End(xlUp).Row + 1, Service) = _
.Sheets(1).Range("Y38")
.Close SaveChanges:=False
End With
Next KW
Case 2
Dienstleistung = "Datastream"
For KW = 1 To 52
Set appOffice = GetObject("D:\Verfügbarkeit\" & Dienstleistung & "\KW-" & Format(KW, "00") & "-" & Dienstleistung & ".xls")
With appOffice
Cells(Cells(65536, Service).End(xlUp).Row + 1, Service) = _
.Sheets(1).Range("AA38")
.Close SaveChanges:=False
End With
Next KW
Case 3
Dienstleistung = "Infoscreen"
For KW = 1 To 52
Set appOffice = GetObject("D:\Verfügbarkeit\" & Dienstleistung & "\KW-" & Format(KW, "00") & "-" & Dienstleistung & ".xls")
With appOffice
Cells(Cells(65536, Service).End(xlUp).Row + 1, Service) = _
.Sheets(1).Range("Z38")
.Close SaveChanges:=False
End With
Next KW
Case 4
Dienstleistung = "RMM"
For KW = 1 To 52
Set appOffice = GetObject("D:\Verfügbarkeit\" & Dienstleistung & "\KW-" & Format(KW, "00") & "-" & Dienstleistung & ".xls")
With appOffice
Cells(Cells(65536, Service).End(xlUp).Row + 1, Service) = _
.Sheets(1).Range("U32")
.Close SaveChanges:=False
End With
Next KW
Case 5
Dienstleistung = "Xtra3000"
For KW = 1 To 52
Set appOffice = GetObject("D:\Verfügbarkeit\" & Dienstleistung & "\KW-" & Format(KW, "00") & "-" & Dienstleistung & ".xls")
With appOffice
Cells(Cells(65536, Service).End(xlUp).Row + 1, Service) = _
.Sheets(1).Range("U32")
.Close SaveChanges:=False
End With
Next KW
End Select
' For KW = 1 To 15
' Set appOffice = GetObject("D:\Verfügbarkeit\" & Dienstleistung & "\KW-" & Format(KW, "00") & "-" & Dienstleistung & ".xls")
' With appOffice
' Cells(Cells(65536, Service).End(xlUp).Row + 1, Service) = _
' .Sheets(1).Range("Y38")
' .Close
' '.Quit
' End With
' Next KW
Next Service
Set appOffice = Nothing
'Application.ScreenUpdating = True
'WochenSpaltenEinfügen
End Sub