Sometimes pastespecial method of range failes 1004 Error

i need you help! So basically what i am trying to do is to copy a filtered range from one workbook (wbimport) into my Active Workbook (wsData). I do it two times. One time with the actual date (szToday) and the date1, because my wbimport file has the date as ending and i need a comparison of the data from both dates.

As mentioned above i get the error pastespecial method of range failes (1004 Error). I know, that there are many oher posts regarding the same error, but i couldnt find any help. I spend so much time and still couldnt figure it out.

The error happens in:

wsData.Range("H1").PasteSpecial xlPasteValues

Thanks in advance!

Sub ImportDat()
 
    Application.DisplayAlerts = False
    Sheets(4).Delete
    Sheets(4).Delete
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = False
    
    szToday = Format(Date, "dd-mm-yy")
    Dim d1 As String
    d1 = Range("b7").Value2
    date1 = Format(d1, "dd-mm-yy")
    
    Dim Dates(1 To 2) As String
    
    Dates(2) = szToday
    Dates(1) = date1
    
    Dim i As Variant
    
    For Each i In Dates()


    Dim App As New Excel.Application 'create a new (hidden) Excel
    
    
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = i
    
    ' remember active sheet
    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Sheets(i)
    
    wsData.Cells.ClearContents

    ' open the import workbook in new Excel (as read only)
    Dim wbImport As Workbook
    Dim FileN As String
    FileN = "***" & Format(i, "YYYY-MM-DD") & ".xlsb"
    Set wbImport = App.Workbooks.Open(Filename:=FileN, UpdateLinks:=True, ReadOnly:=True)
    
    'wbImport.Worksheets("Data").Activate'
    
    'Array für PH1 Bedingungen'
    
    Dim lngCriteriaCountPH1 As Long
    Dim arrCriteriaPH1() As String
    
    lngCriteriaCountPH1 = 6
    
    ReDim arrCriteriaPH1(0 To lngCriteriaCountPH1 - 1)
    
    arrCriteriaPH1(0) = "Commercial All-In-One"
    arrCriteriaPH1(1) = "Commercial Desktop"
    arrCriteriaPH1(2) = "Commercial Notebook"
    arrCriteriaPH1(3) = "Commercial Tablet"
    arrCriteriaPH1(4) = "Visuals"
    arrCriteriaPH1(5) = "Workstation"
    
    'Array für Distributoren'
    
    Dim lngCriteriaCountCN As Long
    Dim arrCriteriaCN() As String
    
    lngCriteriaCountCN = 7
    
    ReDim arrCriteriaCN(0 To lngCriteriaCountCN - 1)
    
    arrCriteriaCN(0) = "ALSO Deutschland GmbH"
    arrCriteriaCN(1) = "api Computerhandels GmbH"
    arrCriteriaCN(2) = "BYTEC Bodry Technology GmbH"
    arrCriteriaCN(3) = "Ingram Micro GmbH"
    arrCriteriaCN(4) = "Ingram Micro Distribution GmbH"
    arrCriteriaCN(5) = "Tech Data Service GmbH"
    arrCriteriaCN(6) = "Tech Data Service GmbH EURO PLAZA, Gebau"
    
    'Autofilter aktivieren'
    Dim LastRowColumnA As Long
    LastRowColumnA = wbImport.Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim LastCol As Long
    LastCol = wbImport.Worksheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column
    ColLetter = Split(Cells(1, LastCol).Address, "$")(1)
 
    Set rngFilterRange = wbImport.Worksheets("Data").Range("A1:" & ColLetter & LastRowColumnA)
    
    rngFilterRange.AutoFilter
    rngFilterRange.AutoFilter Field:=2, Criteria1:="GAT", Operator:=xlFilterValues
    rngFilterRange.AutoFilter Field:=7, Criteria1:=arrCriteriaPH1(), Operator:=xlFilterValues
    rngFilterRange.AutoFilter Field:=19, Criteria1:="Y", Operator:=xlFilterValues
    rngFilterRange.AutoFilter Field:=39, Criteria1:=arrCriteriaCN(), Operator:=xlFilterValues
       
    'copy the data of the import sheet
    wbImport.Worksheets("Data").Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
    wsData.Range("H1").PasteSpecial xlPasteValues
  
    Dim LastRowColumnH As Long
    LastRowColumnH = Cells(Rows.Count, 8).End(xlUp).Row
    
    'PH3 Adjusted'
    Range("G1").Value = "PH3 Adjusted"
    Range("G2:G" & LastRowColumnH).Formula = "=IFERROR(VLOOKUP(N2&P2,Filter!O:P,2,0),P2)"
    
    'HLPCLM'
    Range("F1").Value = "HLPCLM"
    Range("F2:F" & LastRowColumnH).Formula = "=CONCAT(Y2,U2)"
    
    'OLDMFG'
    Range("E1").Value = "OLD MFG"
    Range("E2:E" & LastRowColumnH).Formula = "=IFERROR(IF(VLOOKUP(F2,'" & date1 & "'!F:AN,35,0)=0,"""",VLOOKUP(F2,'" & date1 & "'!F:AN,35,0)),"""")"
    Range("E2:E" & LastRowColumnH).NumberFormat = "dd.mm.yyyy"
    
    'CHANGES'
    Range("D1").Value = "CHANGES"
    Range("D2:D" & LastRowColumnH).Formula = "=IF(AND(AN128="""",E128<>""""),""Deleted"",IF(AND(AN2<>"""",E2=""""),""New"",IF(AN2=E2,"""",IF(AN2>E2,""Postponed"",IF(AN2<E2,""Forwarded"",""-"")))))"
    
    'DISTRIBUTOR'
    Range("C1").Value = "Distributor"
    Range("C2:C" & LastRowColumnH).Formula = "=IF(AT2=""ALSO Deutschland GmbH"",""ALSO"",IF(AT2=""api Computerhandels GmbH"",""API"",IF(AT2=""Bytec Bodry Technology GmbH"",""BYTEC"",IF(OR(AT2=""Ingram Micro Distribution GmbH"",AT2=""Ingram Micro GmbH""),""INGRAM"",IF(OR(AT2=""Tech Data Service GmbH"",AT2=""Tech Data Service GmbH EURO PLAZA, Gebau""),""TECHDATA"","""")))))"

    
    'DEAL PN'
    Range("B1").Value = "Deal PN"
    Range("B2:B" & LastRowColumnH).Formula = "=IFERROR(VLOOKUP(Y2,Filter!S:T,2,0),""No"")"

    App.CutCopyMode = False 'clear clipboard (prevents asking when wb is closed)
    wbImport.Close SaveChanges:=False 'close wb without saving
    App.Quit 'quit the hidden Excel
    
    Next i
    
    'Replace old dates'
    
    
    Worksheets("Summary").Range("B3").Value = szToday
    Worksheets("Summary").Range("E3").Value = date1
    
    
    Sheets("Overview").Select
    Cells(1, 1).Select
   Application.ScreenUpdating = True
End Sub