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
| Sub Copie()
Dim Ligne As Long, Sh As Worksheet, C As Range, ResAdr As String, Ctr As Integer
Set Sh = Sheets("DB")
With Sheets("HOLX_RAXINV_SEL_46907766_1")
.Select
.[A1].Select
Set C = .[E:E].Find("INVOICE", , , xlWhole, , True)
If Not C Is Nothing Then
ResAdr = C.Address
Do
Ligne = Sh.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
Sh.Cells(Ligne, 1) = C.Offset(2)
Sh.Cells(Ligne, 2) = C.Offset(4)
Sh.Cells(Ligne, 3) = C.Offset(6)
Sh.Cells(Ligne, 4) = C.Offset(8)
Sh.Cells(Ligne, 5) = C.Offset(10)
Sh.Cells(Ligne, 6) = C.Offset(4, 1)
Ctr = 0
For i = C.Row + 12 To .Cells(C.Row + 11, 1).End(xlDown).Row
Sh.Cells(Ligne, 7).Offset(Ctr) = .Cells(i, 1)
Ctr = Ctr + 1
Next i
Set C = .[E:E].FindNext(C)
Loop While C.Address <> ResAdr
End If
End With
End Sub |
Partager