Acquisition d'une plage de cellule dynamique

Bonjour ,

Je joins un fichier excel pour illustrer mon besoin.

Je constitue un fichier de devis pour une société (on va dire que c'est une société de wagons ).

Dans les lignes 4 à 16, je mes les références des wagons que mon client veut me commander.

Par exemple, dans l'exemple que j'ai complété, mon client me demandera 2 références de wagons, donc j'ai complété les lignes 4 et 5.

S'il m'en avait demandé 5, j'aurais complété les lignes 4,5,6,7,8...etc

La ligne total vient effectuer des opérations de somme...etc sur mes différents produits.

J'aimerais pouvoir réaliser l'acquisition d'un tableau récapitulant chaque ligne que j'ai complétée plus la ligne total.

J'ai déjà placé sur mon fichier la ligne 20 qui est la copie de ma ligne 2.

J'aimerais dans ce contexte qu'en dessous viennent se mettre les lignes 4,5 et 17.

Mais si mon client m'avait demandé 5 références de wagon, j'aurais aimé pouvoir récupérer en dessous les lignes 4 5 6 7 8 et 17.

Sauriez-vous m'aider avec mon problème ?

Bonne journée à tous

7classeur1.xlsx (11.06 Ko)

Bonjour,

Je ne vois pas trop l’intérêt il y a des outil comme des filtres (Données/ filtrer) qui feront très bien le taf et largement suffisant (d'après votre descriptif).

bonne continuation

Bonjour

Sinon

Code Module associé au bouton en A2

Sub Action()
    Range("B4:P17").Copy
    Range("B21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.ScreenUpdating = False
    Range("B21:B34").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("B21").Select
End Sub

Cordialement

4amodu1244.xlsm (19.84 Ko)

Bonjour

Sinon

Code Module associé au bouton en A2

Sub Action()
    Range("B4:P17").Copy
    Range("B21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.ScreenUpdating = False
    Range("B21:B34").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("B21").Select
End Sub

Cordialement

Merci beaucoup Amadeus !

Je l'ai réadapté à mon fichier original.

Petite question cependant: est il possible de garder la mise en forme des cellules que j'ai copiées ?

Par exemple, mes NON sur mon fichier original sont définis pour s'afficher en rouge sur une case à fond rose.

En appliquant la formule, je retrouve le contenu de la cellule sans la mise en forme

En tout cas merci pour ce code qui marche nickel !

Bonjour

Tu ajoutes l'instruction pour les formats

Sub Action()
    Range("B4:P17").Copy
    Range("B21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.ScreenUpdating = False
    Range("B21:B34").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("B21").Select
End Sub

ou, plus condensé

Sub Action()
    Range("B4:P17").Copy
    Range("B21").Select
    With Selection
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteFormats
    End With
    Application.ScreenUpdating = False
    Range("B21:B34").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("B21").Select
End Sub

Cordialement

Bonjour

Tu ajoutes l'instruction pour les formats

Sub Action()
    Range("B4:P17").Copy
    Range("B21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.ScreenUpdating = False
    Range("B21:B34").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("B21").Select
End Sub

ou, plus condensé

Sub Action()
    Range("B4:P17").Copy
    Range("B21").Select
    With Selection
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteFormats
    End With
    Application.ScreenUpdating = False
    Range("B21:B34").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("B21").Select
End Sub

Cordialement

Merci... je rêverais d'être bon en VBA.

Dernière petite question, en réadaptant le code à mon fichier original, j'ai une erreur 1004 (application ou objet qui s'affiche).

Le code marche cependant quand même mais j'ai ce message d'erreur qui s'affiche à chaque fois. Est ce dû à ce que j'ai écrit ?:

Sub Action()

Range("A13:AC43").Copy

Range("A46").Select

With Selection

.PasteSpecial Paste:=xlPasteValues

.PasteSpecial Paste:=xlPasteFormats

End With

Application.ScreenUpdating = False

Range("A46:B76").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Range("A46").Select

End Sub

Jai trouvé moi même il fallait que je mette B77 !

Merci pour tout !

Bonjour

Chez moi, le code marche parfaitement sur le fichier téléchargé.

Ton fichier est-il différent?

Cordialement

Edit: tu as posté pendant que je contrôlais sur le fichier.

Bonjour

Chez moi, le code marche parfaitement sur le fichier téléchargé.

Ton fichier est-il différent?

Cordialement

Edit: tu as posté pendant que je contrôlais sur le fichier.

Oui j'avais simplifié le fichier que j'avais mis en ligne car mon fichier principal est...très chargé

Tout marche parfaitement maintenant !

J'avais fait une erreur en réadaptant le code !

Merci encore

Bonjour

Chez moi, le code marche parfaitement sur le fichier téléchargé.

Ton fichier est-il différent?

Cordialement

Edit: tu as posté pendant que je contrôlais sur le fichier.

Je me permets de poster une dernière question relative au topic.

Dans mon document original, j'avais un tableau à la droite de celui que j'ai envoyé qui était assez complet.

Lorsque j'applique la formule, ce tableau se fait couper un certain nombre de lignes, car pour que les lignes qui nous intéressent soient collées, on a effacé des lignes entières dont certaines cellules étaient renseignées.

Est il possible d'effacer dans la formule seulement les lignes "blank" correspondant à la plage de colonnes de mon tableau original ?

Par exemple, en ce moment si je complète les lignes 4 et 5, lorsque la macro copie colle, elle va supprimer toutes les lignes qui ne sont pas 4 5 ou 17 pour garder à la suite 4 5 17.

Mon souhaite serait que au lieu d'effacer les lignes 6 à 16, elle efface de B6 à P6 ... B16 à P16 pour qu'à la fin, le résultat soit le même, mais que mes tableaux situés plus loin dans mon fichier original ne soient pas coupés ?

J'imagine la solution est en rapport avec le fait qu'actuellement on demande à la routine d'effacer les lignes entières correspondant aux cases vides.

Bonjour

J'ai travaillé sur l'ancien fichier, tu modifieras.

Sub Action()
Dim Cel As Range
For Each Cel In Range("B4:B17")
If Cel <> "" Then
Range(Cel, Cel.Offset(0, 14)).Copy
If Range("B21") = "" Then
    Range("B21").Select
    ElseIf Range("B21") <> "" Then
    Range("B20").End(xlDown).Offset(1, 0).Select
    End If
With Selection
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteFormats
    End With
End If
Next Cel
Application.CutCopyMode = False
Range("B20").Select
End Sub

Cordialement

3amodu1244.xlsm (20.53 Ko)

Salut Amadeus,

Merci encore une fois pour ton aide.

Je ne suis pas sûr de tout comprendre ce coup ci.

J'ai fait un test sur le fichier que tu m'as renvoyé en remplissant 4 désignations (de B4 à B7).

J'ai aussi rajouté des 5 de R22 à R30 pour voir si ces 5 disparaitront lors de l'activitation de la macro.

Lorsque j'active la macro, j'obtiens l'image que je te fait parvenir en PJ.

Je ten joins une seconde qui montre ce que je souhaiterais (au cas où je me serais mal expliqué).

On voit que les 5 sont toujours là sans avoir disparu tandis que les lignes se sont bien copiées comme souhaité.

Je m'excuse une nouvelle fois du dérangement !

Amodu1244

probleme solution

Bonjour

Il est probable pour obtenir ce résultat que tu as cliqué plusieurs fois sur le bouton associé à la macro.

Pour éviter ce risque, je te suggères d'effacer tout ce qui a été copié précédemment avant de coller les nouvelles valeurs.

Avec cette instruction en début de Code

Range("B21:P34").Clear

Le Code complet

Sub Action()
Dim Cel As Range
Range("B21:P34").Clear
For Each Cel In Range("B4:B17")
If Cel <> "" Then
Range(Cel, Cel.Offset(0, 14)).Copy
If Range("B21") = "" Then
    Range("B21").Select
    ElseIf Range("B21") <> "" Then
    Range("B20").End(xlDown).Offset(1, 0).Select
    End If
With Selection
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteFormats
    End With
End If
Next Cel
Application.CutCopyMode = False
Range("B20").Select
End Sub

Le fichier joint avec ce code

Cordialement

4amodu1244.xlsm (20.66 Ko)

Merci une nouvelle fois !

Je n'ai plus rien à demander

Rechercher des sujets similaires à "acquisition plage dynamique"