Sub Get_Sheet(PasteAsValues As Boolean, SourceShName As String, _
SourceShIndex As Integer, myReturnedFiles As Variant)
Dim mybook As Workbook, BaseWks As Worksheet
Dim CalcMode As Long
Dim SourceSh As Variant
Dim sh As Worksheet
Dim I As Long
Dim NeuerName As String
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
On Error GoTo ExitTheSub
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
If SourceShName = "" Then
SourceSh = SourceShIndex
Else
SourceSh = SourceShName
End If
For I = LBound(myReturnedFiles) To UBound(myReturnedFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(myReturnedFiles(I))
On Error GoTo 0
If Not mybook Is Nothing Then
On Error Resume Next
Set sh = mybook.Sheets(SourceSh)
If Err.Number > 0 Then
Err.Clear
Set sh = Nothing
End If
On Error GoTo 0
If Not sh Is Nothing Then
sh.Copy After:=BaseWks.Parent.Sheets(BaseWks.Parent.Sheets.Count)
On Error Resume Next
<em><strong> If mybook.Name Like "*M6201*" Then
NeuerName = "A10St1"
ElseIf mybook.Name Like "*M6202*" Then
NeuerName = "A10St2"
End If
ActiveSheet.Name = NeuerName
</strong></em>On Error GoTo 0
If PasteAsValues = True Then
With ActiveSheet.UsedRange
.Value = .Value
End With
End If
End If
mybook.Close savechanges:=False
End If
Next I
Application.DisplayAlerts = False
On Error Resume Next
BaseWks.Delete
On Error GoTo 0
Application.DisplayAlerts = True
ExitTheSub:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub