Bonjour,
Je veux réaliser une macro qui me permette d'aller chercher des informations dans un onglet "liste" pour l'envoyer dans l'onglet "mélange".
Les données à aller chercher sont bien sûr soumises à des conditions (sinon c'est moins drôle ).
Et en plus de ça, je veux convertir certaines des données de l'onglet liste.
Donc j'ai écrit ce premier code, pour lequel j'utilise une "zone tampon" dans laquelle je stocke les données de l'onglet "liste" avant de les incrémenter dans l'onglet "mélange".
Remarque : dans les deux cas j'utilise une zone "modèle" : "A6:BC9"
Sub incrémentation()
Worksheets("Mélange").Activate
Dim cell As Range
For Each cell In Worksheets("Liste").Range("F4", Worksheets("Liste").Range("F4").End(xlDown))
Range("B2:BB2").ClearContents 'zone "tampon"
If cell.Value <> ""
Dim mélange
Dim déno_mélange
mélange = cell.Value
déno_mélange= Range(cell.Offset(0, -5), cell.Offset(0, -4)).Value
Range("B2:C2").Value = déno_mélange
Range("D2").Value = mélange
Range("D2").TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
ConsecutiveDelimiter:=True, Semicolon:=True, Space:=True
Range("A6:BC9").copy
Range("A10").Select
Do Until IsEmpty(ActiveCell) = True
ActiveCell.Offset(1, 0).Activate
Loop
ActiveSheet.Paste
Dim code
Dim nom
Dim mix
code = Range("B2").Value
nom = Range("C2").Value
mix = Range("E2:BB2").Value
ActiveCell.Value = code
ActiveCell.Offset(0, 1).Value = nom
Range(ActiveCell.Offset(0, 5), ActiveCell.Offset(0, 54)).Value = mix
End If
Next cell
End Sub
Malheuresement ce code est extrêmement long à exécuter. J'ai supposé que c'était à cause des copier/coller. Donc j'ai essayé cette deuxième version :
Sub incrémentation2()
Dim C1 As Range
For Each C1 In Worksheets("Liste").Range("F4", Worksheets("Liste").Range("F4").End(xlDown))
If C1.Value <> "" Then
Worksheets("mélange").Range("A65536").End(xlUp).Offset(1, 0).Activate
Range("A6:BC9").copy
ActiveSheet.Paste
Dim code
Dim nom
code = C1.Offset(0, -5).Value
nom = C1.Offset(0, -4).Value
ActiveCell.Value = code
ActiveCell.Offset(0, 1) = nom
C1.TextToColumns Destination:=(Worksheets("mélange").Range("A65536").End(xlUp).Offset(0, 5)), DataType:=xlDelimited, _
ConsecutiveDelimiter:=True, Semicolon:=True, Space:=True
End If
Next C1
End Sub
Dans ce cas là, le code ne fonctionne pas du tout...
Il faut que je fasse un tri avant de démarrer la macro dans l'onglet "liste" sur le colonne F pour ne garder que les cellule remplies sinon ça ne fonctionne pas. (il n'y a même pas de message d'erreur mais ça ne fonctionne pas...)
Mon code pour convertir n'a pas l'air de fonctionner lui non plus...
Est ce que quelqu'un a une idée de ce qu'il se passe pour que rien ne bouge sauf si je fais un tri sur la colonne F ?
Et si quelqu'un à une meilleure idée pour améliorer la vitesse du premier code je suis preneur
Merci !!