XL 2010 deplacer donnees colonne

Sub CpyDates()
  Dim plg As Range, cel As Range, dlg&, lig&, k As Byte
  dlg = Cells(Rows.Count, 2).End(3).Row
  Set cel = ActiveCell: Application.ScreenUpdating = 0
  For lig = 3 To dlg
    With Cells(lig, 4)
      If IsEmpty(.Value) Then
        k = 0
        If Not IsEmpty(.Offset(, 2)) Then k = 2 Else _
          If Not IsEmpty(.Offset(, 4)) Then k = 4
        If k > 0 Then
          Set plg = .Offset(, k).Resize(, 2)
          plg.Copy: .PasteSpecial -4163
          plg.ClearContents
        End If
      End If
    End With
  Next lig
  Application.CutCopyMode = 0: cel.Select
End Sub