bigfish,
wahoo, c'est tellement rapide que je pensais que la macro ne s'activait jamais! Merci beaucoup! c'est vraiment génial !
voici mon 2e problème:Sur le deuxième bouton qui est un des plus important , il me permet d'affecter un numéro ( qui correspond en fait au numéro maximum du classeur + 1 ) si l'agent a mis un 'x' sous "numéro de camion". Cependant il est INCROYABLEMENT long puisque le fichier sera par la suite partagé!
Je me demandais si une âme généreuse aurait une idée pour réduire le temps de chargement. sans partage il prends 1-2 secondes et en partage il mets bien 30 à 90 voire 180 secondes.. je pense que le partage y est pour beaucoup mais j'espérais un peu plus rapide étant donné que mon code est assez simplissime et que je pense pouvoir faire mieux aux niveau de la passation de paramètres... (j'avais pensé à mettre une liste des onglets à prendre, mais je me suis pas encore vraiment penché à fond dessus)
Je rappelle que cette macro marche très bien, c'est juste qu'en partage cela mets une éternité.. la macro se base sur mes fameux onglet agent. Je pense que ma passation de paramètres 'attribuer' est convenable mais c'est le fait de recopier tout le temps le même code pour chaque feuille qui doit faire ralentir..
Sub macro_numero()
'nom des feuilles :
F_1 = "CF"
F_2 = "NB"
F_3 = "JM"
F_4 = "Mel"
F_5 = "MA"
F_6 = "PL"
F_7 = "VR"
F_8 = "SM"
F_9 = "MG"
'Préparation de l'onglet synthèse, vide la zone de collecte des données
Sheets("BDD").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
'Sélectionne la feuille qu'il faut copier
Sheets(F_1).Select
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2").Select 'sélectionne la cellule ou il faut coller
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_2).Select 'feuille 02
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_3).Select 'feuille 03
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_4).Select 'feuille 04
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_5).Select 'feuille 05
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_6).Select 'feuille 06
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_7).Select 'feuille 07
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_8).Select 'feuille 08
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_9).Select 'feuille 09
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets("Extraction").Select
'affecter numéro
numero = 1
suivant = Worksheets("Extraction").Range("E4")
Feuille = F_1
Call attribuer(Feuille, numero, suivant)
Feuille = F_2
Call attribuer(Feuille, numero, suivant)
Feuille = F_3
Call attribuer(Feuille, numero, suivant)
Feuille = F_4
Call attribuer(Feuille, numero, suivant)
Feuille = F_5
Call attribuer(Feuille, numero, suivant)
Feuille = F_6
Call attribuer(Feuille, numero, suivant)
Feuille = F_7
Call attribuer(Feuille, numero, suivant)
Feuille = F_8
Call attribuer(Feuille, numero, suivant)
Feuille = F_9
Call attribuer(Feuille, numero, suivant)
End Sub
Private Sub attribuer(Feuille, numero, suivant)
With Worksheets(Feuille).Range("J7:J89")
Set c = .Find("x", LookIn:=xlValues)
If Not c Is Nothing Then
Do
c.Value = suivant + numero
Set c = .FindNext(c)
numero = numero + 1
Loop While Not c Is Nothing
End If
End With
End Sub
en tout un grand merci pour le premier problème ! ;)
Je mettrais 'réponse validée' une fois que j'aurais pu avoir été aidée sur mes 3 points au cas ou quelqu'un veuille jeter un œil entre deux.
Jennifer