Transfert de donnees

Bonjour le Forum,

ci joint un code:

Sub Valide()
Dim rng As Range, c As Range, ws As Worksheet, dl As Long
Application.ScreenUpdating = False
Dim nomfeuil As String
With Sheets("PLANNING JOUR")
    Set rng = .Range("C8:A" & .Range("A65000").End(xlUp).Row)
        For Each c In rng
        If c <> "" Then
            On Error Resume Next
            Set ws = Sheets(CStr(c))
            On Error GoTo 0
            If Not ws Is Nothing Then
                    With ws
                    [color=#FF0000]dl = .Range("A65000").End(xlUp).Row + 1[/color]
                    .Range("A" & dl).Resize(1, 8).Value = c.Offset(, 1).Resize(1, 8).Value

                End With
            End If
            Set ws = Nothing
        End If
    Next
End With
Application.ScreenUpdating = True

End Sub

la ligne rouge me renvoi les données mais au lieu de les rajoutés a la suite ,il faudrait si possible:

Exemple: que le 12 janvier se place sur la colonne "A15" car ma première cellule de l'année commence en "A4"

merci pour votre aide

Bonjour le Forum,

alors toujours personne pour ce code

dl = .Range("A65000").End(xlUp).Row + 1

Bonjour,

A tester, mais sans fichier

Sub Valide()
Dim rng As Range, c As Range, ws As Worksheet, dl As Long
Application.ScreenUpdating = False
Dim nomfeuil As String
With Sheets("PLANNING JOUR")
    Set rng = .Range("C8:A" & .Range("A65000").End(xlUp).Row)
        For Each c In rng
        If c <> "" Then
            On Error Resume Next
            Set ws = Sheets(CStr(c))
            On Error GoTo 0
            If Not ws Is Nothing Then
                    With ws
                   dl = .Range("A".Rows.count).End(xlUp).Row + 1
                    .Range("A" & dl).Resize(1, 8).Value = c.Offset(, 1).Resize(1, 8).Value                    
                End With
            End If
            Set ws = Nothing
        End If
    Next
End With
Application.ScreenUpdating = True
End Sub