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 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
| Sub SaisieNouveau()
Dim i As Long, j As Long, LastLig As Long
Dim o As Object, bd As Object
Dim Tb, RES()
Dim DerCol As Integer
Dim Val1 As String
'-------------------------------------------------------------------------
Application.EnableEvents = False
Application.ScreenUpdating = False
Set bd = Sheets("A") 'définit l'onglet bd
Dl = bd.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit derlg col1 onglet A
Set o = Sheets("B")
On Error Resume Next
With bd
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
Tb = .Range("A2:H" & LastLig)
End With
With o 'Worksheets("A")
DerCol = o.Range("A7").End(xlToRight).Column
Val1 = .Range("B1") 'N°P
For i = 1 To LastLig - 1
If Tb(i, 1) = Val1 Then
j = j + 1
ReDim Preserve RES(1 To 12, 1 To j)
RES(1, j) = j
RES(2, j) = Tb(i, 2)
RES(3, j) = Tb(i, 3)
'format nombre 0.00 ou vide
If RES(4, j) <> "" Then
RES(4, j) = Round(Tb(i, 4), 2) 'PK
Else
RES(4, j) = Tb(i, 4)
End If
RES(7, j) = Tb(i, 5) 'DIR
End If
Next i
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
If LastLig > 8 Then .Range("A8:H" & LastLig).Clear
If j > 0 Then .Range("A8").Resize(j, 12) = Application.Transpose(RES)
.Range("A8").Resize(j, DerCol).Borders.Weight = xlThin
.Range("A8").Resize(j, DerCol).Font.Name = "calibri"
.Range("A8").Resize(j, DerCol).Font.Size = 12
.Range("A8").Resize(j, DerCol).HorizontalAlignment = xlCenter
.Range("A8").Resize(j, DerCol).VerticalAlignment = xlCenter
.Range("H8:H" & LastLig).Resize(j, DerCol).HorizontalAlignment = xlLeft
End With
Range("E8").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub |
Partager