0

What I am trying to do is:

  1. create new Sheet in my Active Workbook (wsData)

  2. Open workbook with Filename (wbimport)

  3. Autofilter for Array (arrCriteriaPH1())

  4. Copy filtered Cells from wbimport into wsData in my initial Workbook.

My Problem:

The code works only sometimes, even though I don't change anything. Sometimes both worksheets get generated, sometimes only one and I get the error of paste special method of Range Class failed. Import data is always the same.

I tried to reduce the code as much as possible. Hopefully someone is able to help!

Error appears almost at the end of the loop:

wsData.Cells.ClearContents
    wbImport.Worksheets("Data").UsedRange.SpecialCells(xlCellTypeVisible).Copy
    wsData.Range("J1").PasteSpecial Paste:=xlPasteValues




For Each i In Dates()
    
    
    Dim App As New Excel.Application 'create a new (hidden) Excel
    
    'create new sheet for new data'
    
    Sheets.Add After:=ActiveSheet
    
    ActiveSheet.Name = i
    
    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 = "\\10.64.1.151\Load And Cover\Load And Cover_Ops Internal\Load_and_Cover_" & Format(i, "YYYY-MM-DD") & ".xlsb"
    Set wbImport = App.Workbooks.Open(Filename:=FileN, UpdateLinks:=True, ReadOnly:=True)
    
    'wbImport.Worksheets("Data").Activate'
    
    'Array for Autofilter criteria'
    
    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"
    
    
    '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
     
       
    'copy the data of the import sheet
    
    wsData.Cells.ClearContents
    wbImport.Worksheets("Data").UsedRange.SpecialCells(xlCellTypeVisible).Copy
    wsData.Range("J1").PasteSpecial Paste:=xlPasteValues
    
    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
greybeard
  • 2,249
  • 8
  • 30
  • 66
Mark
  • 21
  • 1

0 Answers0