Problème Macro Extraction
J'ai créé un formulaire sur lequel je sélectionne une zone (par exemple zone 20) et il va ensuite chercher dans la feuille "Palettes" toutes les lignes contenant dans la colonne "Zone" le nombre 20. Il doit ensuite les copier et les coller en valeurs dans la feuille d'exploitation (cellule A10) et copier les lignes qui contiennent dans la colonne "Nombre de palettes" la mention "À décaler" et les coller dans la feuille Surplus. J'ai commencé à faire un code VBA cependant il ne fonctionne pas comme je le souhaite (j'ai réussi avec les filtres mais ce n'est pas le résultat escompté).La liste déroulante du formulaire se trouve dans la feuille "Paramètres" et se nomme "Liste Zone". J'aimerai savoir s'il n'y pas un moyen de réaliser ma manip.
En vous souhaitant une bonne journée,
Cordialement,
Salut dieselovitch,
quelque chose ainsi ?
Une info est incertaine : faut-il aussi copier les lignes "Á décaler" dans 'Exploitation' ou uniquement dans 'Surplus' ?
Private Sub btnExtraction_Click()
'
Dim sWkEXP As Worksheet, sWkSUR As Worksheet, iRow1%, iRow2%, iCol%
'
Set sWkEXP = Worksheets("Exploitation")
Set sWkSUR = Worksheets("Surplus")
'
With Worksheets("Palettes")
.Range("A1").CurrentRegion.Sort key1:=.[K2], order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
iRow1 = .Columns("K").Find(what:=Me.Cbzone.Text, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
iRow2 = .Columns("K").Find(what:=Me.Cbzone.Text, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row
'
sWkEXP.[A10].Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).Value = ""
If iRow1 > 0 Then _
sWkEXP.[A10].Resize(iRow2 - iRow1 + 1, .UsedRange.Columns.Count).Value = _
.Range("A" & iRow1).Resize(iRow2 - iRow1 + 1, .UsedRange.Columns.Count).Value
End With
With sWkEXP
If .[A10] <> "" Then
.Range("A10").Resize(iRow2 - iRow1 + 1, .UsedRange.Columns.Count).Sort key1:=.[N10], order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlNo
iRow1 = .Columns("N").Find(what:="À décaler", lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
iRow2 = .Columns("N").Find(what:="À décaler", lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row
sWkSUR.[A2].Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).Value = ""
sWkSUR.[A2].Resize(iRow2 - iRow1 + 1, .UsedRange.Columns.Count).Value = _
sWkEXP.Range("A" & iRow1).Resize(iRow2 - iRow1 + 1, .UsedRange.Columns.Count).Value
If .Range("A" & Rows.Count).End(xlUp).Row > 10 Then _
.Range("A10").Resize(.Range("A" & Rows.Count).End(xlUp).Row - 9, .UsedRange.Columns.Count).Sort _
key1:=.[G10], order1:=xlAscending, _
key2:=.[C10], order2:=xlAscending, _
key3:=.[B10], order3:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlNo
If iRow2 > iRow1 Then _
sWkSUR.Range("A1").Resize(iRow2 - iRow1 + 1, .UsedRange.Columns.Count).Sort _
key1:=sWkSUR.[G2], order1:=xlAscending, _
key2:=sWkSUR.[C2], order2:=xlAscending, _
key3:=sWkSUR.[B2], order3:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
.Activate
End If
End With
'
End Sub
Joyeux Noël !
A+
Salut curulis57,
Tout d'abord, merci beaucoup, c'est une aide incroyable que tu m'apportes ! En effet, il faudrait que les lignes "Á décaler" ne soit pas copier dans "Exploitation" mais dans "Surplus" uniquement. Les lignes "Á décaler", doivent être placé les unes après les autres. Enfin, j'ai remarqué que pour certaines zones, j'ai ce message qui s'afficher (pièce jointe) mais que les lignes étaient quand même exportées.
Merci encore !!!
Bonne journée,
Salut curulis57,
Désolé pour mon retard je n'ai pas pu avancer cette dernière semaine. J'ai testé le fichier et il fonctionne, cependant j'ai un problème avec la zone 10. En effet, l'interface bug et m'affiche cela (ci-dessous).
De plus, l'interface bug aussi dans la feuille Surplus et m'affiche cela (ci-dessous).
On peut aussi voir que la première colonne affiche certains N°SSCC en puissance.
Je vous remercie vraiment pour l'aide apporté !
Bonne année !
Cordialement,