Copie/coller de données vers autre feuille d'un même classeur + fusion de cellule en fonction d'une variable

**jeremy383** · 05/11/2014, 11h48

Bonjour,

Je réalise actuellement une macro pour automatiser la création d’une feuille de relevé de poids rempli manuellement par un opérateur sur le terrain.
L’idée est d’extraire les données d’une feuille pour les transférer et les mettre en forme en fonction de la quantité réceptionnée du jour.

La macro doit dans un premier temps transférer certaines des données d’une feuille appelée « Commandes » vers une autre feuille de relevé de poids appelée «Feuille ».
La macro doit ensuite fusionner les cellules pour créer plusieurs lignes en fonction du nombre de palettes en colonne I de la feuille « Feuille »).

J’ai fait le code pour la première colonne mais j’ai quelques soucis : quand je colle les données dans ma feuille de relevé la case sélectionné à la fin du collage n'est pas celle ou les données ont été collées - je ne peux donc pas enchainer mon code pour fusionner mes lignes en fonction de mon nombre de palettes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
 
Sub Copier()
 
    Dim numligne As String
    numligne = ActiveCell.Row
 
    Sheets("Commandes").Select
    Range("A" & numligne).Select
    Selection.Copy
 
    With Sheets("Feuille")
        ActiveSheet.Paste Destination:=.Range("A" & .Range("A" & Rows.Count).End(xlUp).Row).Offset(1)
    Application.CutCopyMode = False
    .Activate
    End With
 
    Range ("A" & numligne & .Range("A" & Range("I" & numligne-1)).Select)
    ' La macro plante ci dessus : 
    ' je souhaite sélectionner la case de mon activecell (point de départ) jusqu'à mon point arrivée activecell + valeur nombre de ligne présente en colonne I-1
 
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
 
 End Sub

Ci joint une image du résulta attendu :

Nom : Capture.PNG
Affichages : 2382
Taille : 28,8 Ko

Merci pour votre aide.

**vinc_bilb** · 05/11/2014, 14h52

Bonjour

Sur la forme ....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'Range ("A" & numligne & .Range("A" & Range("I" & numligne)).Select)
    Range("A" & numligne & ":I" & numligne).Select

Ca devrait améliorer

Vous pourriez également passer par le CurrentRegion comme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Dim SrcRng As Range, CopyRng As Range
 
Set SrcRng = ThisWorkbook.Worksheets("Commandes").Range("A1").CurrentRegion
Debug.Print SrcRng.Address
 
Set SrcRng = SrcRng.Columns(1)
Debug.Print SrcRng.Address

Sur le fond, je me permets quelques commentaires ....
- Ne jamais se mélanger le crayons avec la déclaration des variables: numligne As String par exemple, vous allez droit dans des codes difficiles avec des conversions à la pèle
- Un TCD / Pivot devrait pouvoir le faire, peut-être, voir exemple non dégrossi en PJ Nom : Capture.JPG
Affichages : 2219
Taille : 110,2 Ko

Nom : Capture.JPG
Affichages : 2219
Taille : 110,2 Ko

Bonne journée

**jeremy383** · 05/11/2014, 16h01

Merci pour tes éléments de réponse vinc_bilb

Tout d'abord pour le code, celui-ci ne rempli pas ma fonction car je cherche à gérer mon point de départ grâce à l'active.Cell de la valeur que je recopie et mon point d'arrivée grâce à la valeur de la cellule présente en I

En gros ça pourrait donner ça de façon algorithmique "primaire" (je suis débutant en vba) :
Range(A&ActiveCell.row:A&(ActiveCell.row+valeur de la case en I - 1)

En ce qui concerne le TCD, il ne répond pas à mes besoins puisque je cherche à automatiser la mise en forme.
Aujourd'hui, la personne fait des copier coller des données et ajoute des lignes "manuellement" comme dans ma photo en PJ plus haut pour créer les lignes qui lui manque.

**vinc_bilb** · 05/11/2014, 17h13

Rebonjour,

J'avais aussi corrigé votre code d'origine

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'Range ("A" & numligne & .Range("A" & Range("I" & numligne)).Select) 'Erreur
    Range("A" & numligne & ":I" & numligne).Select

**jeremy383** · 06/11/2014, 09h04

Le code proposé permet de selecter la ligne de Ax à Ix
Or dans mon cas, je souhaite sélecter la colonne de Ax à A(x+y-1) ou y est la valeur de la cellule Ix

Malgrès une nuit (presque) complète à rechercher le bon code, je n'arrive toujours pas à mes fins.
Je suis plutôt pugnace mais j'avoue que là je bloque complètement !
Quelqu'un pourrais m"éclairer sur le sujet ?

Merci beaucoup.

**vinc_bilb** · 06/11/2014, 09h44

Bonjour,

Je ne retrouve pas votre fichier d'origine,(pas Glop

), pouvez-vous le remettre SVP?
Merci

**jeremy383** · 06/11/2014, 14h21

Bonjour Vincent,

Ci joint le fichier.

Merci pour votre aide.
Macro pesée.xlsx

**vinc_bilb** · 06/11/2014, 21h44

et bien .... je sèche lamentablement

J'ai quand même .... essayé de :
- vous mettre des appels de type VLOOKUP (voir exemple en feuille FeuilleVB)
- réussi à insérer des lignes (voir Macro en module 1), qui insère et plante tout ....

Désolé

**jeremy383** · 07/11/2014, 08h41

Ok c'est pas grave. Je vais essayer de faire autrement et de retravailler mon code.
Merci beaucoup pour votre aide en tout cas.

**vinc_bilb** · 07/11/2014, 14h10

Bonjour,

Comme je suis un gros frustré quand je ne trouve pas, ça me gâche l'ambiance

Ca marche, voir fichier ci-joint, macro "AddRowTrial" dans le module 1

et regarder aussi les equations si vous voulez voir l'usage des LOOKUP que j'ai fait

Bonne journée

**jeremy383** · 07/11/2014, 14h39

Ok c'est fonctionne super bien en effet.

Par contre, pour être honnête j'ai pas trop compris le code.

Pourriez m'expliquer un peu plus en détails la démarche pour comprendre le principe et progresser.
Cela me permettra aussi de finaliser la macro pour qu'elle me fusionne par la même occasion les lignes des colonnes A,B,C et D en fonction du nombre de lignes insérées pour faciliter la lisibilité de l'opérateur.

Merci beaucoup pour ce coup de pouce c'est top !

**vinc_bilb** · 07/11/2014, 15h05

Quelques explications:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
ThisWorkbook.Worksheets("FeuilleVB").Activate
 
Set SrcRng = ThisWorkbook.Worksheets("FeuilleVB").Range("A3").CurrentRegion
'J'étends la sélection à la région (equivaut à un CTRL + * sous excel)
 
For RowN = SrcRng.Rows(SrcRng.Rows.Count).Row To SrcRng(2, 1).Row Step -1
'C'est là que je merdais; je commence à la dernière ligne du range trouvé, et je m'arrête à sa deuxième
 
    If Cells(RowN, 1) <> "" And Cells(RowN, 9) > 0 Then
    'Je regarde si la cellune en A&Rown n'est pas vide et si I&RowN contient une valeur non nulle (ces deux conditions déclenchent l'insertion)
 
        RoWNb = Cells(RowN, 9) - 1  'Je récupère le nombre de lignes à insérer
        Rows(RowN).Copy   'Je sélection la ligne source pour copie
 
        With Rows(RowN + 1 & ":" & RowN + RoWNb)  'et j'insère dessous
            .Insert Shift:=xlShiftDown
        End With
 
        Rows(RowN + 1 & ":" & RowN + RoWNb).ClearContents 'puis je vide uniquement le contenu
 
    End If
 
Next RowN

et voilà....

Attention, il faudra certainement que vous adaptiez le code pour tester si la cellule Cells(RowN, 1) est mergée ou non .... Piège

Avec l'ajout du code pour le test de merge et sa gestion:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
For RowN = SrcRng.Rows(SrcRng.Rows.Count).Row To SrcRng(2, 1).Row Step -1
 
    If Cells(RowN, 1) <> "" And Cells(RowN, 9) > 0 And Cells(RowN, 1).MergeCells = False Then
 
        RoWNb = Cells(RowN, 9) - 1
        Rows(RowN).Copy
 
        With Rows(RowN + 1 & ":" & RowN + RoWNb)
            .Insert Shift:=xlShiftDown
        End With
 
        Rows(RowN + 1 & ":" & RowN + RoWNb).ClearContents
 
        Range(Cells(RowN, 1), Cells(RowN + RoWNb, 1)).Merge
 
    End If
 
Next RowN

**jeremy383** · 07/11/2014, 16h40

Ca marche très bien pour la colonne A.
Du coup j'ai voulu modifier et le faire pour la B, C et la D mais là tout se complique !

J'ai tâtonné un peu mais à chaque fois il reste en colonne A....
Comment faire pour qu'il passe en B puis, C puis D ??

**vinc_bilb** · 12/11/2014, 11h12

Bonjour,

en retard mais bon, j'ai abandonné Excel pour quelques jours ....
Il suffit de parcourir les colonnes 1 à 4 et de faire le merge

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub AddRowTrial()
 
Dim SrcRng As Range, ClArt As Range
Dim RoWNb As Integer, RowN As Integer, ColN As Integer
 
Application.CutCopyMode = False
 
ThisWorkbook.Worksheets("FeuilleVB").Activate
 
Set SrcRng = ThisWorkbook.Worksheets("FeuilleVB").Range("A3").CurrentRegion
Debug.Print SrcRng.Address, SrcRng.Rows(SrcRng.Rows.Count).Row, SrcRng(2, 1).Row
 
For RowN = SrcRng.Rows(SrcRng.Rows.Count).Row To SrcRng(2, 1).Row Step -1
 
    If Cells(RowN, 1) <> "" And Cells(RowN, 9) > 0 And Cells(RowN, 1).MergeCells = False Then
 
        RoWNb = Cells(RowN, 9) - 1
        Rows(RowN).Copy
 
        With Rows(RowN + 1 & ":" & RowN + RoWNb)
            .Insert Shift:=xlShiftDown
        End With
 
        Rows(RowN + 1 & ":" & RowN + RoWNb).ClearContents
 
' On parcourt les 4 premières colonnes 
        For ColN = 1 To 4
 
            Range(Cells(RowN, ColN), Cells(RowN + RoWNb, ColN)).Merge
 
        Next ColN
 
    End If
 
Next RowN
 
 
End Sub

Bonne journée

**jeremy383** · 13/11/2014, 15h53

Bonjour,

Ok. Je n'y avais pas pensé en effet !

Merci beaucoup c'est parfait.

**jeremy383** · 23/02/2015, 18h13

Bonjour vinc_bilb,

Je déterre un peu le post mais suite à une petite évolution du fichier de ma part...et bien plus rien ne fonctionne ....
Lors du lancement de la macro pour les merge il y a un bug que je n'arrive pas à comprendre qui me met le programme en débogage

J'ai mis le fichier en PJ pour mieux comprendre

**vinc_bilb** · 24/02/2015, 09h54

Bonjour,

Essayez avec (corrigé : RoWNb = Cells(RowN, 9) - 1)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Sub AddRowTrial()
 
Dim SrcRng As Range, ClArt As Range
Dim RoWNb As Integer, RowN As Integer, ColN As Integer
 
Application.CutCopyMode = False
 
ThisWorkbook.Worksheets("R").Activate
 
Set SrcRng = ThisWorkbook.Worksheets("R").Range("A3").CurrentRegion
Debug.Print SrcRng.Address, SrcRng.Rows(SrcRng.Rows.Count).Row, SrcRng(2, 1).Row
 
For RowN = SrcRng.Rows(SrcRng.Rows.Count).Row To SrcRng(2, 1).Row Step -1
 
    If Cells(RowN, 1) <> "" And Cells(RowN, 9) > 0 And Cells(RowN, 1).MergeCells = False Then
 
        'RoWNb = Cells(RowN, 9) - 1
        RoWNb = RowN - 1
        Rows(RowN).Copy
 
        With Rows(RowN + 1 & ":" & RowN + RoWNb)
            .Insert Shift:=xlShiftDown
        End With
 
        Rows(RowN + 1 & ":" & RowN + RoWNb).ClearContents
 
' On parcourt les 4 premières colonnes
        For ColN = 1 To 4
 
            Range(Cells(RowN, ColN), Cells(RowN + RoWNb, ColN)).Merge
 
        Next ColN
 
    End If
 
Next RowN
 
 
    ActiveWindow.SelectedSheets.PrintPreview
 
 
    'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
 
 
 
 
 
End Sub

Copie/coller de données vers autre feuille d'un même classeur + fusion de cellule en fonction d'une variable

Macros et VBA Excel

Discussions similaires

Partager

Partager