Тип Несовпадение для получения значения года

Question

У меня есть сообщение об ошибке

Тип Mismatch

на линии If Year(.Range("AJ" & X).Value2) = 2015 Then

макро показывает Year(.Range("AJ" & X).Value2) СОСТАВЛЯЕТ Ошибка 2042, я не конечно, что с этим делать.

Полный код здесь:

Sub WintelPatch() 
'// Declare your variables. 
Dim wSheet1 As Worksheet, _ 
wSheet2 As Worksheet, _ 
wSlastRow As Long, _ 
X As Long, _ 
wkbSourceBook As Workbook, _ 
wkbCrntWorkBook As Workbook, _ 
worksheetName As String, _ 
Default As String 

Set wkbCrntWorkBook = ActiveWorkbook 
'// Set here Workbook(Sheets) names 
Set wSheet2 = wkbCrntWorkBook.ActiveSheet 

'extract data from another excel file 
With Application.FileDialog(msoFileDialogOpen) 
.Filters.Clear 
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xls" 
.AllowMultiSelect = False 
.Show 
If .SelectedItems.Count > 0 Then 

    'Prompts user to choose which Worksheet they want to copy from 
    MSG1 = MsgBox("Do you wish to copy from 'Overall details' ?", vbYesNo, "Name of Worksheet") 
    If MSG1 = vbYes Then 
     worksheetName = "Overall details" 
    Else 
     Default = "Sheet" 
     worksheetName = Application.InputBox("Enter the name of Worksheet (Case-sensitive)", Default, Default) 
    'End of first If statement 
    End If 

    Set wkbSourceBook = Workbooks.Open(.SelectedItems(1)) 
    Set wSheet1 = wkbSourceBook.Sheets(worksheetName) 

    With wSheet1 
    '// Here lets Find the last row of data 
    wSlastRow = .Rows(.Range("B:B").Rows.Count).End(xlUp).Row 

    '// Now Loop through each row 
    For X = 2 To wSlastRow 
    'insert wSlastRow no of rows to worksheet Summary 
    'wSheet1.Rows(wSlastRow).Insert Shift:=xlDown 
    If Not IsError(.Range("AJ" & X).Value2) Then 
     If IsDate(.Range("AJ" & X).Value2) Then 
      If Year(.Range("AJ" & X).Value2) = 2015 Then 
       .Range("B" & X).Copy Destination:=wSheet2.Range("B" & X) 
       .Range("AJ" & X).Copy Destination:=wSheet2.Range("J" & X) 
      End If 
     ElseIf IsDate("01-" & .Range("AJ" & X).Value2) Then 
      If Year("01-" & .Range("AJ" & X).Value2) = 2015 Then 
       .Range("B" & X).Copy Destination:=wSheet2.Range("B" & X) 
       .Range("AJ" & X).Copy Destination:=wSheet2.Range("J" & X) 
      End If 
     End If 
    End If 
    Next X 

    End With 
    wkbSourceBook.Close False 
End If 
End With 

'Free objects 
Set wkbCrntWorkBook = Nothing 
Set wSheet2 = Nothing 
Set wkbSourceBook = Nothing 
Set wSheet1 = Nothing 

'// Simple Msg Box 
MsgBox "Copy & Paste is Done." 
End Sub 

Вот данные в столбце B и AJ, которые являются именами хостов и дата моего макроса необходимо скопировать другой лист (образец данные для справки):

Answer 1

Вы должны проверить, если ячейка содержит дату первого:

For X = 2 To wSlastRow 
    'insert wSlastRow no of rows to worksheet Summary 
    'wSheet1.Rows(wSlastRow).Insert Shift:=xlDown 
    If Not IsError(.Range("AJ" & X).Value2) Then 
     If IsDate(.Range("AJ" & X).Value2) Then 
      If Year(.Range("AJ" & X).Value2) = 2015 Then 
       .Range("B" & X).Copy Destination:=wSheet2.Range("B" & X) 
       .Range("AJ" & X).Copy Destination:=wSheet2.Range("J" & X) 
      End If 
     ElseIf IsDate("01-" & .Range("AJ" & X).Value2) Then 
      If Year("01-" & .Range("AJ" & X).Value2) = 2015 Then 
       .Range("B" & X).Copy Destination:=wSheet2.Range("B" & X) 
       .Range("AJ" & X).Copy Destination:=wSheet2.Range("J" & X) 
      End If 
     End If 
    End If 
Next X 

Answer 2

Я думаю, что нам не нужно столько проверок. Если тип ячейки Date, этот код должен также быть работа:

For X = 2 To wSlastRow 
    If IsDate(.Range("AJ" & X)) Then 
     If Year(.Range("AJ" & X)) = 2015 Then 
      .Range("B" & X).Copy Destination:=wSheet2.Range("B" & X) 
      .Range("AJ" & X).Copy Destination:=wSheet2.Range("J" & X) 
     End If 
    End If 
Next X