Amélioration de code

Bonjour,

J'ai effectué un code qui permet de créer et effacer des qr-codes, techniquement, il fonctionne cependant j'aimerais si possible l'améliorer.

Ci-joint, les deux codes.

Sub Zebra()

Dim enregistrement As Range
Dim donnee As String
Dim newforme As Shape
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set x = Worksheets("Qr-Code")
Set newfeuille = Worksheets("Qr-Code")

'Selectionne les données d'entrées pour les QR-codes
Worksheets("Qr-Code").Activate
I = Range("A2")
V = "%09"
L = "%0D"

'1er QR-code sur la feuille
Set cellule = newfeuille.Range("C1")
donnee = "http://api.qrserver.com/v1/create-qr-code/?data=" & I & V & L & "&size=250x250"
Set newforme = x.Shapes.AddShape(msoShapeRectangle, cellule.Left, cellule.Top, 55, 55)
newforme.Name = "QR1"
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Range("C5") = I

'2nd QR-code sur la feuille
Set cellule = newfeuille.Range("D1")
donnee = "http://api.qrserver.com/v1/create-qr-code/?data=" & I & V & L & "&size=250x250"
Set newforme = x.Shapes.AddShape(msoShapeRectangle, cellule.Left, cellule.Top, 55, 55)
newforme.Name = "QR2"
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Range("D5") = I

'3ème QR-code sur la feuille
Set cellule = newfeuille.Range("C7")
donnee = "http://api.qrserver.com/v1/create-qr-code/?data=" & I & V & L & "&size=250x250"
Set newforme = x.Shapes.AddShape(msoShapeRectangle, cellule.Left, cellule.Top, 55, 55)
newforme.Name = "QR3"
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Range("C11") = I

'4ème QR-code sur la feuille
Set cellule = newfeuille.Range("D7")
donnee = "http://api.qrserver.com/v1/create-qr-code/?data=" & I & V & L & "&size=250x250"
Set newforme = x.Shapes.AddShape(msoShapeRectangle, cellule.Left, cellule.Top, 55, 55)
newforme.Name = "QR4"
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Range("D11") = I
End Sub

Sub effacer()
Dim newforme As Shape
'effacer le 1er Qr code'
    Range("C5").Clear
    ActiveSheet.Shapes("QR1").Delete
'effacer le 2nd Qr code'
    Range("D5").Clear
    ActiveSheet.Shapes("QR2").Delete
'effacer le 3ème Qr code'
    Range("C11").Clear
    ActiveSheet.Shapes("QR3").Delete
'effacer le 4ème Qr code'
    Range("D11").Clear
    ActiveSheet.Shapes("QR4").Delete
End Sub

Merci d'avance pour votre aide.

Bien cordialement

Windows / Edge 106.0.1370.47