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 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
| Dim tabCellules(), compteur As Integer
Dim cellule As Range
Dim b As Integer
Dim i As Integer, j As Integer, k As Integer
Dim rfound As Range
Dim nb_lignes As Long
' stockage des lignes sélectionnées par clic-droit
compteur = 0
For Each cellule In Selection
ReDim Preserve tabCellules(compteur)
tabCellules(compteur) = cellule.Row
compteur = compteur + 1
Next cellule
If compteur = 0 Then
MsgBox "Aucune ligne n'a été sélectionnée. Veuillez sélectionner une ligne."
Exit Sub
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open Filename:="C:\Users\JULIEN\Desktop\remise de prix type.xls"
Application.DisplayAlerts = True
Workbooks("remise de prix type.xls").Worksheets("Feuil1").Activate
nb_lignes = Worksheets("Feuil1").Range("D65536").End(xlUp).Row
' Recherche de "Référence" dans la colonne 'D'
With Worksheets("Feuil1")
Set rfound = .Range("D1:D" & nb_lignes).Find("Référence", LookIn:=xlValues)
End With
' Si trouvé
If Not rfound Is Nothing Then
i = rfound.Row
i = i + 1
End If
j = i + 1
Do Until Cells(j, 4).Value = "xxxx"
Worksheets("Feuil1").Rows(j).Delete Shift:=xlUp
Loop
k = i
For j = 0 To UBound(tabCellules)
k = k + 1
Worksheets("Feuil1").Rows(k).Insert
'Rows(k).Interior.ColorIndex = xlNone
With Worksheets("Feuil1")
.Range("D" & k).Value = Workbooks("CLASSEUR CALCUL DE PRIX 2015.xls").Worksheets("PRIX").Cells(tabCellules(j), 2)
.Range("F" & k).Value = Workbooks("CLASSEUR CALCUL DE PRIX 2015.xls").Worksheets("PRIX").Cells(tabCellules(j), 3)
.Range("H" & k).Value = Mid(Workbooks("CLASSEUR CALCUL DE PRIX 2015.xls").Worksheets("PRIX").Cells(tabCellules(j), 8), 1, 4)
.Range("I" & k).Value = Workbooks("CLASSEUR CALCUL DE PRIX 2015.xls").Worksheets("PRIX").Cells(tabCellules(j), 7)
.Range("Q" & k).Value = Workbooks("CLASSEUR CALCUL DE PRIX 2015.xls").Worksheets("PRIX").Cells(tabCellules(j), 31)
.Range("R" & k).FormulaR1C1 = "=RC[-1]*RC[-3]"
End With
With Worksheets("Feuil1").Range("E" & k & ":G" & k).Cells
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenterAcrossSelection
End With
'Worksheets("Feuil1").Range("E" & k & ":G" & k).MergeCells = True
If Workbooks("CLASSEUR CALCUL DE PRIX 2015.xls").Worksheets("PRIX").Cells(tabCellules(j), 4) = "OXY_" Then
With Worksheets("Feuil1")
.Range("J" & k).Value = "Ox"
.Range("N" & k).Value = "Gr/Eb"
End With
End If
Next j
Worksheets("Feuil1").Range("R" & k + 1).FormulaLocal = "=somme(R" & i + 1 & ":R" & k & ")"
Worksheets("Feuil1").Range("D" & i & ":R" & i).Copy
Worksheets("Feuil1").Range("D" & i + 1 & ":R" & k).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Worksheets("Feuil1").Range("D" & i - 1 & ":R" & k).Columns.AutoFit
With Worksheets("Feuil1").Range("D" & i + 1 & ":R" & k)
.Font.Bold = False
.Interior.ColorIndex = xlNone
End With
Worksheets("Feuil1").Range("Q:R").NumberFormat = "#,##0.00 $"
Application.ScreenUpdating = True |
Partager