Probleme de selection de cellule

bonjour
voici mon code j'ais un problème en voulant sélectionner une cellule , il me met une erreur" erreur définie par l'application ou par l'objet"
je ne comprends pas pourquoi
j'ais marquer ou est l'erreur , elle me bloque pour la suite


Sub ouverture_classeur()
Application.ScreenUpdating = False
Dim Date1 As Date
Dim date2 As Date
Dim x As Integer

'**************ON OUVRE LE CLASSEUR*********

Workbooks.Open ("C:\VBAPointeuse\Salariés\Listesalariés.xlsm")

Sheets("Listesalariés").Activate
Derligne = Range("H1").End(xlDown).Row
Derligne1 = Range("D1").End(xlDown).Row

For I = 1 To Derligne1
For j = 1 To Derligne

'*********SI DANS LA COLONNE D ET H IL Y A UNE CORESPONDANCE************

If Range("H" & j).Value = Range("D" & I).Value Then

'***************ON OUVRE LE CLASSEUR CORESPONDANT********************

Workbooks.Open ("c:\VBAPointeuse" & "\" & "Pointage" & "\" & Range("D" & I).Offset(0, -2).Value & Range("D" & I).Offset(0, -1).Value & Range("D" & I).Offset(0, -3).Value & (".xlsx"))
'*************ON ACTIVE LE CLASSEUR PRECEDENT*********

Workbooks("Listesalariés.xlsm").Activate


' **********ON SELECTIONNE ET COPIE LA DEUXIEME CELLULE VERS LA GAUCHE******

Date1 = Range("e" & j).Value
Heure = Range("F" & j).Value
Range("H" & j).Offset(0, -2).Select
Selection.Copy

'**********ON ACTIVE LE CLASSEUR CORESPONDANT OUVERT AVANT*******

Windows(Range("D" & I).Offset(0, -2).Value & Range("D" & I).Offset(0, -1).Value & Range("D" & I).Offset(0, -3).Value & (".xlsx")).Activate

'**********JE CALCULE LE NOMBRESE DE JOURS SUIVANAT LA DATE TROUVER AVANT********

x = DateDiff("d", Date1, "01/01/2015")
'*************JE SELECTIONNE LE PREMIER JOUR DE L'ANNEE

Range("A6").Select

'*****************JE LUI DIT DE SELECTIONNER LA CELLULE CORESPONDANT A LA DATE TROUVER AVANT**********

ActiveCell.Offset(x, 0).Select 'L'ERREUR EST ICI

'For Y = 6 To 371

' If Range("A", x).Value = Date1 Then
' Range("A" & x).Select

ii = 1

Do While Not (IsEmpty(ActiveCell))
ii = ii + 1
Selection.Offset(0, 1).Select
Loop
ActiveSheet.Paste
Application.CutCopyMode = False
GoTo suivant

' ElseIf Range("S" & Y).Value > 8 Then
Range("K" & Y).Value = "Erreur nombre pointage"

' End If

' Next Y

suivant:
ActiveWorkbook.Save
'ActiveWorkbook.Close

Windows("Listesalariés.xlsm").Activate

End If
Next j
Next I
End Sub