XL 2016 Amélioration vba

[Guismo33]

Bonjour a tous,
je ne suis pas très fort en Vba , mais j'ai réussi a faire celle ci qui es un peut longue.
je souhaiterais savoir si ont peut améliorer cette Vba.


Sub REUNION1()
Dim i As Integer, lig As Long, lig2 As Long
With Sheets("R1").Select
lig = Cells(3, Columns.Count).End(xlToLeft).Column + 1
lig2 = Cells(38, Columns.Count).End(xlToLeft).Column + 1
For i = 1 To 6
Cells(3 + i, lig).Value = Cells(3 + i, 24).Value
Cells(10 + i, lig).Value = Cells(10 + i, 24).Value
Cells(17 + i, lig).Value = Cells(17 + i, 24).Value
Cells(24 + i, lig).Value = Cells(24 + i, 24).Value
Cells(31 + i, lig).Value = Cells(31 + i, 24).Value
Cells(38 + i, lig).Value = Cells(38 + i, 24).Value
Cells(45 + i, lig).Value = Cells(45 + i, 24).Value
Cells(38 + i, lig2).Value = Cells(38 + i, 24).Value
Cells(45 + i, lig2).Value = Cells(45 + i, 24).Value
Next i
Cells(3, lig) = Range("a1").Value
Cells(38, lig2) = Range("a1").Value
End With
Range("Tiercé").ClearContents
Range("compteur") = Range("compteur") + 1
End Sub


merci a vous



bien à vous

 

[Robert]

Bonjour Guismo, bonjour le forum

Erreur :
With Sheets("R1").Select
doit être :
With Sheets("R1")

ensuite, tout ce qui fait référence à cet onglet doit être précédé d'un point. Comme je ne sais pas de quoi on parle tu adapteras :

Sub REUNION1()
Dim i As Integer, lig As Long, lig2 As Long

With Sheets("R1")
    lig = .Cells(3, Columns.Count).End(xlToLeft).Column + 1
    lig2 = .Cells(38, Columns.Count).End(xlToLeft).Column + 1
    For i = 1 To 6
        .Cells(3 + i, lig).Value = .Cells(3 + i, 24).Value
        .Cells(10 + i, lig).Value = .Cells(10 + i, 24).Value
        .Cells(17 + i, lig).Value = .Cells(17 + i, 24).Value
        .Cells(24 + i, lig).Value = .Cells(24 + i, 24).Value
        .Cells(31 + i, lig).Value = .Cells(31 + i, 24).Value
        .Cells(38 + i, lig).Value = .Cells(38 + i, 24).Value
        .Cells(45 + i, lig).Value = .Cells(45 + i, 24).Value
        .Cells(38 + i, lig2).Value = .Cells(38 + i, 24).Value
        .Cells(45 + i, lig2).Value = .Cells(45 + i, 24).Value
    Next i
    .Cells(3, lig) = .Range("a1").Value
    .Cells(38, lig2) = .Range("a1").Value
End With
Range("Tiercé").ClearContents
Range("compteur") = Range("compteur") + 1
End Sub

 

[Guismo33]

Bonjour Guismo, bonjour le forum

Erreur :
With Sheets("R1").Select
doit être :
With Sheets("R1")

ensuite, tout ce qui fait référence à cet onglet doit être précédé d'un point. Comme je ne sais pas de quoi on parle tu adapteras :

Sub REUNION1()
Dim i As Integer, lig As Long, lig2 As Long

With Sheets("R1")
    lig = .Cells(3, Columns.Count).End(xlToLeft).Column + 1
    lig2 = .Cells(38, Columns.Count).End(xlToLeft).Column + 1
    For i = 1 To 6
        .Cells(3 + i, lig).Value = .Cells(3 + i, 24).Value
        .Cells(10 + i, lig).Value = .Cells(10 + i, 24).Value
        .Cells(17 + i, lig).Value = .Cells(17 + i, 24).Value
        .Cells(24 + i, lig).Value = .Cells(24 + i, 24).Value
        .Cells(31 + i, lig).Value = .Cells(31 + i, 24).Value
        .Cells(38 + i, lig).Value = .Cells(38 + i, 24).Value
        .Cells(45 + i, lig).Value = .Cells(45 + i, 24).Value
        .Cells(38 + i, lig2).Value = .Cells(38 + i, 24).Value
        .Cells(45 + i, lig2).Value = .Cells(45 + i, 24).Value
    Next i
    .Cells(3, lig) = .Range("a1").Value
    .Cells(38, lig2) = .Range("a1").Value
End With
Range("Tiercé").ClearContents
Range("compteur") = Range("compteur") + 1
End Sub

bonjour robert,

donc si je comprend bien c'est que dés que tu utilise WITH ,il faut utiliser le point devant Cells
je viens d apprendre ,je ne ferais plus la même erreur la prochaine fois.
en te remerciant..


bien à vous

 

[Guismo33]

Bonjour Guismo, bonjour le forum

Erreur :
With Sheets("R1").Select
doit être :
With Sheets("R1")

ensuite, tout ce qui fait référence à cet onglet doit être précédé d'un point. Comme je ne sais pas de quoi on parle tu adapteras :

Sub REUNION1()
Dim i As Integer, lig As Long, lig2 As Long

With Sheets("R1")
    lig = .Cells(3, Columns.Count).End(xlToLeft).Column + 1
    lig2 = .Cells(38, Columns.Count).End(xlToLeft).Column + 1
    For i = 1 To 6
        .Cells(3 + i, lig).Value = .Cells(3 + i, 24).Value
        .Cells(10 + i, lig).Value = .Cells(10 + i, 24).Value
        .Cells(17 + i, lig).Value = .Cells(17 + i, 24).Value
        .Cells(24 + i, lig).Value = .Cells(24 + i, 24).Value
        .Cells(31 + i, lig).Value = .Cells(31 + i, 24).Value
        .Cells(38 + i, lig).Value = .Cells(38 + i, 24).Value
        .Cells(45 + i, lig).Value = .Cells(45 + i, 24).Value
        .Cells(38 + i, lig2).Value = .Cells(38 + i, 24).Value
        .Cells(45 + i, lig2).Value = .Cells(45 + i, 24).Value
    Next i
    .Cells(3, lig) = .Range("a1").Value
    .Cells(38, lig2) = .Range("a1").Value
End With
Range("Tiercé").ClearContents
Range("compteur") = Range("compteur") + 1
End Sub

Bonjour Robert,

suite a ta réponse Vba j'ai pu améliorer ma Vba , mais voila sur la nouvelle
je veux juste copier sans les formules :


Sub REUNION2()
Dim i As Integer, lig As Long, lig2 As Long
With Sheets("R2")
col = .Cells(3, Columns.Count).End(xlToLeft).Column + 1
.Range("Selection2").Copy Destination:=.Cells(3, col) <<-------ICI IL DOIT AVOIR UNE FIN DE FORMULE
.Cells(3, col) = .Range("a1").Value

End With
Range("Tiercé").ClearContents
Range("compteur") = Range("compteur") + 1
MsgBox "Terminée"
End Sub

merci

bien à vous

 

[eriiic]

Bonjour,

pour coller la valeur :

.Cells(3, col).value = Range("Selection2").value

mais tu écrases tout de suite avec la ligne de code suivante (?!?)
eric