Freeze on specific sheet during macro execution and loop through each sheets containing a specific name

[Peachforyou]

I need your help with the code I created below. I tried to avoid the “Select” and “Activate” commands as much as I could.
The parts not working are especially loop parts ( marked as --- not working --- ) and I really don’t get what the problem could be. I think a reason might be that I have to “activate” them first somehow? But please see for yourself.
Unfortunately, the part which displays sheet “X” and freezing the screen onto it isn't working too. I wanted to display a picture on sheet “x” with a coffee image and the message: “please wait” until the macro is finished.
If you can optimize the code to look better or make it shorter, I would also really appreciate it, because I'm a pretty beginner in VBA, and it was hard enough for me to make it this far.

'Option Explicit
Sub Analysis ()

      'Variables
       Dim Destbook As Workbook
       Dim Sourcebook As Workbook
       Dim DestCell As Range
       Dim xFile As String
       Dim xFolder As String
       Dim xFiles As New Collection
       Dim xSheets As Worksheet
       Dim xCount As Long
       Dim xSheetCount As Long
       Dim xRow As Long
       Dim A As Integer
       Dim I As Integer
       Dim Z As Integer
       Dim xMax As Double
           
       
      'On a System Error go to "Troubleshooting" and display the ocurred fault code
       On Error GoTo Troubleshooting
       
      'Deactivate Alerts
       Application.DisplayAlerts = False
       Application.ScreenUpdating = False
       Application.UseSystemSeparators = False

      'Display hidden Sheet "X", select cell "A1" and freeze screen
      ' -------------------------  NOT WORKING  ---------------------
       ActiveWorkbook.Sheets("X").Visible = xlSheetVisible
       With ActiveWorkbook.Sheets("X")
       Application.Goto .Range("A1")
       ActiveWindow.FreezePanes = True
       End With
    
      'Deactivate Alerts
       Application.DisplayAlerts = False
       Application.ScreenUpdating = False
       Application.UseSystemSeparators = False
          
      'Delete contents for each Sheet containing the name "Data" for the selected range
      ' -------------------------  NOT WORKING  ---------------------
       xSheetCount = ActiveWorkbook.Worksheets.Count
       For Z = 1 To xSheetCount '
       If Left(xSheets.Name, 4) = "Data" Then
       
       With ActiveSheet
        .Range("B5:K90000").ClearContents
       End With
       
       End If
       Next Z
       
      'Select the folder with the desired data to import
       With Application.FileDialog(msoFileDialogFolderPicker)
           .Title = "Select Folder"
           .ButtonName = "Import Data"
           .InitialView = msoFileDialogViewList
           If .Show = -1 Then xFolder = .SelectedItems(1)
           If Right(xFolder, 1) <> "\" Then xFolder = xFolder & "\"
       End With
       
      'On error or no files found display the following
       If xFolder = "" Then
       MsgBox ("No files found or selected!")
       Exit Sub
       End If
       
      'Get the desired Textfiles in the selected Folder
       Set FS = CreateObject("Scripting.FileSystemObject")
       Set Folder = FS.Getfolder(xFolder)
       For Each File In Folder.Files
       If File.Name Like "*####-##-##*" Then
       xFile = File.Name
       If xFile <> "" Then
       xCount = xCount + 1
       xFiles.Add xFile, xFile
       If xFile = "" Then Resume Next
       End If
       End If
       Next
  
      'File processing
       I = 1
       Set Destbook = ThisWorkbook
       If xFiles.Count > 0 Then
       For A = 1 To xFiles.Count
       Set Sourcebook = Workbooks.Open(xFolder & xFiles.Item(A), local:=True)
       
      'Skip files with no current values greater than 2 A
       xMax = Application.WorksheetFunction.Max(Range("C2:C90000"))
       If xMax < 2 Then
       GoTo ContinueLoop
       End If
       
       If InStr(1, ActiveSheet.Name, "Stufe", vbTextCompare) <> 0 Then
       Columns("I:Y").Delete
       Rows(1).Insert
       Range("D1").Value = ActiveSheet.Name
       xRow = Cells(Rows.Count, 1).End(xlUp).Row
       ActiveSheet.Range("A1:J" & xRow).Copy
       End If
       
       ThisWorkbook.Sheets("Data (" + CStr(I) + ")").Range("B3").PasteSpecial Paste:=xlPasteAll
       Application.CutCopyMode = False
       On Error Resume Next
       On Error GoTo 0
       I = I + 1
       
ContinueLoop: Sourcebook.Close False
       Next
       End If

      'Just some formatting things...
      ' -------------------------  NOT WORKING  ---------------------
       xSheetCount = ActiveWorkbook.Worksheets.Count
       For I = 1 To xSheetCount
       If Left(Worksheet.Name, 4) = "Data" Then

       With ActiveSheet.Range("A1:J" & xRow)
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlCenter
           Range("B3:C3").Merge
           Range("B3").Value = "Filename:"
           Range("B3:K4").Font.Bold = True
           Range("B4:K4").Borders.LineStyle = xlContinuous

       End With
       End If
       Next I

      'Delete sheet "Import data", hide sheet "X" and save file
      'Sheets("Import data").Delete
       ActiveWorkbook.Sheets("X").Visible = xlSheetVeryHidden
       Application.DisplayAlerts = True
       Application.ScreenUpdating = False
       Application.UseSystemSeparators = True
      'DestBook.SaveAs Filename:=CStr(Date) + "Analysis", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
       
      'Display the occured error message and exit program
Troubleshooting: Application.DisplayAlerts = True
                 Application.ScreenUpdating = True
                 If Err.Number <> 0 Then MsgBox "Troubleshooting: " & _
                 Err.Number & vbLf & Err.Description: Err.Clear
        
Exit Sub

 

[BSALV]

     With ActiveWorkbook.Sheets("X")
          ActiveWindow.FreezePanes = False
          Application.Goto .Range("A1")     'A1 in topleft corner
          Application.Goto .Range("B2"), 0     'B2 = to define the panes
          ActiveWindow.FreezePanes = True
     End With

important in a With ... End With, you use a point in front to refer to that With

    xSheetCount = ActiveWorkbook.Worksheets.Count
     For I = 1 To xSheetCount
          With ActiveWorkbook.Worksheets(I)
               If Left(.Name, 4) = "Data" Then

                    With .Range("A1:J" & xRow)
                         .HorizontalAlignment = xlCenter
                         .VerticalAlignment = xlCenter
                         .Range("B3:C3").Merge
                         .Range("B3").Value = "Filename:"
                         .Range("B3:K4").Font.Bold = True
                         .Range("B4:K4").Borders.LineStyle = xlContinuous
                    End With
               End If
          End With
     Next I

If Left(.Name, 4) = "Data" Then
use option compare text or use Ucase or Lcase for both terms to make the comparison case insensitive.

 

[Peachforyou]

    xSheetCount = ActiveWorkbook.Worksheets.Count
     For I = 1 To xSheetCount
          [B][COLOR=rgb(250, 197, 28)]With ActiveWorkbook.Worksheets(I)  [/COLOR][/B]
               If Left(.Name, 4) = "Data" Then

                    With .Range("A1:J" & xRow)
                         .HorizontalAlignment = xlCenter
                         .VerticalAlignment = xlCenter
                         .Range("B3:C3").Merge
                         .Range("B3").Value = "Filename:"
                         .Range("B3:K4").Font.Bold = True
                         .Range("B4:K4").Borders.LineStyle = xlContinuous
                    End With
               End If
          End With
     Next I

I get the following error on the marked cell after trying to execute the code ( Runtime Error 9 : Subscript out of range )
I also replaced the first part you posted ( with sheet "X" ) and it still remains on the first Sheet ( data import ) during execution
Do you got any ideas what else i can try ?

 

[BSALV]

i have no clue, if you add 2 msgboxes in between, what do they say of abnormal things

xSheetCount = ActiveWorkbook.Worksheets.Count
 For I = 1 To xSheetCount
msgbox i
msgbox   ActiveWorkbook.Worksheets(I).name
If Left(.Name, 4) = "Data" Then

 

[Peachforyou]

I tested the code today at our company with Excel 2017, and it worked just fine.
I deleted the entire part and repasted it on my personal pc and now the loop works just smooth on Excel 365 too. Thank you so far .

The only thing left is the "problem" with the Sheet X I want to show until the macro is finished. It does nothing and stays on the "home sheet" I start the macro with.
Is there a better possibility to make this work too?

 

[BSALV]

At the beginning of the macro "Analysis" you find twice these 3 lines and in between you make X visible and goto there.

 'Deactivate Alerts
     Application.DisplayAlerts = False
     Application.ScreenUpdating = False
     Application.UseSystemSeparators = False

I would start with deleting the 1st appearence of these lines before the "X".
It's the "Application.ScreenUpdating = False" which is the key, so the code 'll now show your "X" and with the following "Application.ScreenUpdating = False", the screen is frozen until the macro ends or until an "Application.ScreenUpdating = True" (see last part of your macro in the "Troubleshooting:")
Summary : pay attention to the positions where you switch the screenupdating on and off.
(the other 2 lines, i didn't read the whole macro, but i'm not sure about their usefulness)