1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
| Sub test()
Dim PlageTravail As Range, c As Range
Dim NumCol As Integer
Dim NumLign As Long
Dim Prem As String
Application.ScreenUpdating = False
With Worksheets("CTRL comptage 1")
NumLign = .Range("G" & .Rows.Count).End(xlUp).Row
NumCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
Set PlageTravail = .Range(.Cells(3, 7), .Cells(NumLign, NumCol))
End With
With PlageTravail
Set c = .Find("Recomptage", LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Prem = c.Address
Do
Envoi c
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Prem
End If
End With
Set PlageTravail = Nothing
End Sub
Private Sub Envoi(ByVal v As Range)
With Worksheets("Destination") 'à adpter
With .Cells(.Rows.Count, 1).End(xlUp)(2)
.Resize(, 7).Value = v.Offset(, 1 - v.Column).Resize(, 7).Value
.Offset(, 7).Value = v.Offset(3 - v.Row).Value
End With
End With
End Sub |