Petit Bug Macro

[laraviole]

Bonsoir tout le monde
Pour acrémenter mes lignes automatiquement et en dynamique avec une formule j'avais deux solutions de macro . tout fonctionne parfaitement sauf dans le cas ou il y a une seule ligne dans mon trie automatique.
La premiere commande était :
Selection.AutoFill Destination:=Range("B1:B" & Range("A65536").End(xlUp).Row)
Range("B1:B" & Range("B65536").End(xlUp).Row).Select
La deuxiéme qui fonctionne aussi bien mais avec le même souci
With [B1]
.Formula = "=RIGHT(A1,8)"
.AutoFill Destination:=Range("B1:B" & Range("A65536").End(xlUp).Row)
End With
With Range([B1], [B65536].End(xlUp))
.Copy
[B1].PasteSpecial Paste:=xlPasteValues
[E1].PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End Sub

Ci joint un petit exemple de fichier excel . Tant que la ligne A a au mois deux lignes cela fonctionne mais dés qu'il n'y a qu'une ligne c'est le KO
Pouvez m'aider ?
Avec tous mes remerciements
🙂

 

[Gorfael]

Re : Petit Bug Macro

Bonsoir tout le monde
Pour acrémenter mes lignes automatiquement et en dynamique avec une formule j'avais deux solutions de macro . tout fonctionne parfaitement sauf dans le cas ou il y a une seule ligne dans mon trie automatique.
La premiere commande était :
Selection.AutoFill Destination:=Range("B1:B" & Range("A65536").End(xlUp).Row)
Range("B1:B" & Range("B65536").End(xlUp).Row).Select
La deuxiéme qui fonctionne aussi bien mais avec le même souci
With [B1]
.Formula = "=RIGHT(A1,8)"
.AutoFill Destination:=Range("B1:B" & Range("A65536").End(xlUp).Row)
End With
With Range([B1], [B65536].End(xlUp))
.Copy
[B1].PasteSpecial Paste:=xlPasteValues
[E1].PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End Sub

Ci joint un petit exemple de fichier excel . Tant que la ligne A a au mois deux lignes cela fonctionne mais dés qu'il n'y a qu'une ligne c'est le KO
Pouvez m'aider ?
Avec tous mes remerciements
🙂

Salut
essaies

Sub Macro1()
[B1].Formula = "=RIGHT(A1,8)"
    'Selection.AutoFill Destination:=Range("B1:B1")
   'Range("B1:B17").Select
If [A65536].End(xlUp).Row > 1 Then _
    Range("B1").AutoFill Destination:=Range("B1:B" & Range("A65536").End(xlUp).Row)
Range("B1:B" & Range("A65536").End(xlUp).Row).Copy
[B1].PasteSpecial Paste:=xlPasteValues
[E1].PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

si un truc te gêne, élimines-le 😀
A+

 

[ninbihan]

Re : Petit Bug Macro

Bonsoir le forum, Gorfael et laraviole
voici avec une boucle:
Sub macro2
For i = 1 To Range("A65536").End(xlUp).Row
Cells(i, 2).Formula = "=RIGHT(A" & i & ",8)"
Cells(i, 5) = Cells(i, 2)
Next i
End sub

 

[Gorfael]

Re : Petit Bug Macro

Bonsoir le forum, Gorfael et laraviole
voici avec une boucle:
Sub macro2
For i = 1 To Range("A65536").End(xlUp).Row
Cells(i, 2).Formula = "=RIGHT(A" & i & ",8)"
Cells(i, 5) = Cells(i, 2)
Next i
End sub

Salut
la macro conserve les valeurs en écrasant les formules 😀
Sauf qu'il manque un nettoyage du genre
Range("B:B,E:E").ClearContents
Mais c'est une autre histoire
A+

 

[Besnard68]

Re : Petit Bug Macro

Bonsoir Laraviole, ninbihan, Gorfael et le forum,

Essaie cette macro.

Je l'ai testée sur ton fichier et ça marche.

Cordialement

Sub Macro3()

Range("A65536").Select
Selection.End(xlUp).Select
Range(ActiveCell, "A1").Select
Selection.Offset(0, 1).Formula = "=RIGHT(A1,8)"

Range("B65536").Select
Selection.End(xlUp).Select
Range(ActiveCell, "B1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

End Sub

 

[laraviole]

Re : Petit Bug Macro

Bonsoir Besnard68,Gorfael,ninbihan et tout le forum
Que vous dire d'autre que vous êtes génial, toutes les solutions fonctionnent .
Merci à vous tous pour ce coup de main
Cordialement
🙂