XL 2016 Avis / Aide réécriture code

[safranien]

Bonjour à tous

je vous sollicite pour avoir votre avis sur l'écriture du code du fichier en PJ. Je ne suis pas assidu en VBA et ai essayer de faire au mieux en fonction de ce que je réussissais à trouver sur le forum.

Le but du code est de trouver l'avant dernière ligne de la feuille 1 basé sur la détection de la colonne K qui contient une formule sur toute la colonne. Copier/insérer ligne copiée autant de fois que le nombre saisi dans la msgbox. Et même chose sur la feuille 2. Sachant que la feuille 2 reprend les colonnes de la feuille 1 mais disposées dans un autre ordre. Une formule me récupérant les valeurs de chaque ligne correspondant à l'en-tête de colonne. Donc je peux supprimer ou ajouter les lignes que je veux sur la feuille 1, les données de la ligne 6 de la feuille 1 se retrouveront dans la ligne 6 de la feuille 2 etc.

Le code fonctionne mais je suis preneur de vos corrections plus "pro" qui me permettront également de m'améliorer.

Merci et bonne fin de journée

 

[TooFatBoy]

Et j'avoue ne pas avoir pu tester le "mettre la ligne épaisse en haut de l'après-dernière ligne (mais ce n'est qu'une hypothèse et il faut donc tester pour voir si ça fonctionne)," je suis pris par le temps et les réunions.

On comprend ça. Du coup, pas de souci avec ça. 😉
Donc si depuis tu as eu le temps de tester, tu as vu que ça fonctionnait et qu'il n'y avait donc pas besoin de changer le code VBA pour que le trait épais reste en bas de la dernière ligne, même en recopiant la dernière ligne plusieurs fois.. 😉

 

[TooFatBoy]

Maintenant qu'on voit un peu mieux ce que tu veux faire, je te propose ceci qui est un récapitulatif des différentes propositions (copie seulement les colonnes voulues, pas besoin de ligne inutilisée en fin de tableau, mise à la hauteur désirée des nouvelles lignes insérées) :

Sub test1()
'
Dim xCount&, X1&, X2&, X3&
Dim HauteurVoule%

    Application.ScreenUpdating = False

    X1 = Sheets("Feuil1").Cells(Rows.Count, "K").End(xlUp).Row '- 1
    X2 = Sheets("Feuil2").Cells(Rows.Count, "C").End(xlUp).Row '- 1
    X3 = Sheets("Feuil1").Cells(Rows.Count, "G").End(xlUp).Row + 1

    xCount = Application.InputBox("Nombre de lignes", "Saf", , , , , , 1)
    If xCount < 1 Then
        MsgBox "Le nombre de lignes entré est erroné. Veuillez recommencer", vbInformation, "Saf"
        GoTo GestionErreur
    End If

    HauteurVoulue = 33.75

    With Sheets("Feuil2")
        .Range("A" & X2 & ":K" & X2).Copy
        .Range("A" & X2 + 1 & ":A" & X2 + xCount).Insert Shift:=xlDown
        .Range("A" & X2 + 1 & ":A" & X2 + xCount).RowHeight = HauteurVoulue                 ' Hauteur des lignes définie dans la varieble "HauteurVoulue"
'        .Range("A" & X2 + 1 & ":A" & X2 + xCount).RowHeight = .Range("A" & X2).RowHeight    ' Même hauteur que la ligne copiée
'        .Range("A" & X2 + 1 & ":A" & X2 + xCount).Rows.AutoFit                              ' Adaptation automatique de la hauteur
    End With

    With Sheets("Feuil1")
        .Range("A" & X1 & ":K" & X1).Copy
        .Range("A" & X1 + 1 & ":A" & X1 + xCount).Insert Shift:=xlDown
        .Range("A" & X1 + 1 & ":A" & X1 + xCount).RowHeight = HauteurVoulue
'        .Range("A" & X1 + 1 & ":A" & X1 + xCount).RowHeight = .Range("A" & X1).RowHeight
'        .Range("A" & X1 + 1 & ":A" & X1 + xCount).Rows.AutoFit
    End With

    Application.CutCopyMode = False

GestionErreur:
 
End Sub

Code modifié suite à l'excellente remarque de Phil69970 sur mon erreur de déclaration des variables. Merci à lui.

 

[safranien]

Merci beaucoup. Je testerai plus tard.
Bonne soirée

 

[Phil69970]

@safranien

Mais pour tout expliquer, le problème n'est pas mon chef mais un client exigeant qui veut un affichage de la sorte.

Raison de plus pour lui montrer beaucoup plus pro que ce qu'il veut hormis la 1ere fois il devrait vite comprendre les avantages avec une nouvelle version.
Maintenant si cela te vas c'est parfait mais 6 variables pour chercher des dernières lignes c'est un peu beaucoup pour moi

TFB
Attention si plus de 32767 lignes dans le fichier il aura une surprise.

Bonne journée

 

[TooFatBoy]

Attention si plus de 32767 lignes dans le fichier il aura une surprise.

Tu as encore une fois 100 % raison. Bien vu.
Je vais tenter de corriger ça dans mon message 32. Merci.

Le pire c'est que c'est justement ce que je venais de vérifier... 🤪

 

[safranien]

ça n'ira pas jusque là. Avec certitude.

 

[TooFatBoy]

ça n'ira pas jusque là. Avec certitude.

Même s'il n'y a aucune chance d'atteindre, voire dépasser, les 32768 lignes, je préfère toujours utiliser un Long, plutôt qu'un Integer quand il s'agit de lignes. 😉

Je remercie encore le camarade Phil69970 d'avoir fait la remarque.

 

[Phil69970]

ça n'ira pas jusque là. Avec certitude.

Certes mais si il s'amuse à rajouter 33000 lignes pour voir !!!

C'est cela que tu peux lui apporter comme différence ==> un fichier qui ne plante pas en essayant par hasard n'importe quoi.

 

[safranien]

Maintenant qu'on voit un peu mieux ce que tu veux faire, je te propose ceci qui est un récapitulatif des différentes propositions (copie seulement les colonnes voulues, pas besoin de ligne inutilisée en fin de tableau, mise à la hauteur désirée des nouvelles lignes insérées) :

Sub test1()
'
Dim xCount&, X1&, X2&, X3&
Dim HauteurVoule%

    Application.ScreenUpdating = False

    X1 = Sheets("Feuil1").Cells(Rows.Count, "K").End(xlUp).Row '- 1
    X2 = Sheets("Feuil2").Cells(Rows.Count, "C").End(xlUp).Row '- 1
    X3 = Sheets("Feuil1").Cells(Rows.Count, "G").End(xlUp).Row + 1

    xCount = Application.InputBox("Nombre de lignes", "Saf", , , , , , 1)
    If xCount < 1 Then
        MsgBox "Le nombre de lignes entré est erroné. Veuillez recommencer", vbInformation, "Saf"
        GoTo GestionErreur
    End If

    HauteurVoulue = 33.75

    With Sheets("Feuil2")
        .Range("A" & X2 & ":K" & X2).Copy
        .Range("A" & X2 + 1 & ":A" & X2 + xCount).Insert Shift:=xlDown
        .Range("A" & X2 + 1 & ":A" & X2 + xCount).RowHeight = HauteurVoulue                 ' Hauteur des lignes définie dans la varieble "HauteurVoulue"
'        .Range("A" & X2 + 1 & ":A" & X2 + xCount).RowHeight = .Range("A" & X2).RowHeight    ' Même hauteur que la ligne copiée
'        .Range("A" & X2 + 1 & ":A" & X2 + xCount).Rows.AutoFit                              ' Adaptation automatique de la hauteur
    End With

    With Sheets("Feuil1")
        .Range("A" & X1 & ":K" & X1).Copy
        .Range("A" & X1 + 1 & ":A" & X1 + xCount).Insert Shift:=xlDown
        .Range("A" & X1 + 1 & ":A" & X1 + xCount).RowHeight = HauteurVoulue
'        .Range("A" & X1 + 1 & ":A" & X1 + xCount).RowHeight = .Range("A" & X1).RowHeight
'        .Range("A" & X1 + 1 & ":A" & X1 + xCount).Rows.AutoFit
    End With

    Application.CutCopyMode = False

GestionErreur:
 
End Sub

Code modifié suite à l'excellente remarque de Phil69970 sur mon erreur de déclaration des variables. Merci à lui.

Testé ! Magnifique ! Grand merci !!!!!
Et l'histoire de la ligne épaisse, je ne connaissais pas cette astuce et l'impact de la manière dont on la met. Génial !

Encore merci à tous.

Bonne soirée

 

[TooFatBoy]

Et l'histoire de la ligne épaisse, je ne connaissais pas cette astuce et l'impact de la manière dont on la met. Génial !

Rassure-toi, tu n'es pas le seul. Je crois que très très peu de gens ont vraiment compris comment fonctionnent exactement les bordures. 😉

 

[safranien]

Rassure-toi, tu n'es pas le seul. Je crois que très très peu de gens ont vraiment compris comment fonctionnent exactement les bordures. 😉

Et je me faisais cette remarque il y a qques jours de pas comprendre pourquoi dans un cas là bordure se recopiais et sans un autre non. Maintenant c'est pigé !