Copie qui s'arrête via code vb

**xszma** · 18/07/2019, 10h36

Bonjour à tous,

J'ai un problème de copie lorsque je souhaite copier deux colonnes d'une feuille (nommé Extraction) vers une autre feuille (nommé analyse), je souhaite automatisé cette tache car j'ai beaucoup de données et cela est plus simple. J'ai donc esquissé un code VB (que vous trouverez ci-dessous) pour réaliser cette tâche. Or les colonnes ne se copie pas entièrement! Je vous glisse aussi en pièce jointe un exemple avec un classeur Excel avec beaucoup moins de données. Vous pouvez lancer la macro et voir le problème !
J'espère avoir été le plus clair possible.

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
 
Sheets("Extraction").Select
 
        i = 3
        j = 5
 
    Do While Cells(i, j) <> "Recettes - Missions"
        If j < 80 Then
        j = j + 1
        Else
        MsgBox "La colonne n'existe pas !"
 
        End If
    Loop
 
    Cells(i, j).Select
    Range(Selection, Selection.End(xlDown)).Copy
 
    Sheets("Analyse").Select
        Range("A65536").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
 
  Sheets("Extraction").Select
 
        i = 3
        j = 5
 
    Do While Cells(i, j) <> "Recettes - Hors Missions"
        If j < 80 Then
        j = j + 1
        Else
        MsgBox "La colonne n'existe pas !"
 
        End If
    Loop
 
    Cells(i, j).Select
    Range(Selection, Selection.End(xlDown)).Copy
 
    Sheets("Analyse").Select
        Range("B65536").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste

Merci par avance de votre aide,

xszma.

**halaster08** · 18/07/2019, 11h28

Bonjour,

.End(xlDown) s'arrête a la première cellule vide qu'il trouve.
As-tu des cellules vide dans ta colonne ? Si oui il faut mieux partir du bas de la feuille et faire un end(xlup) pour trouver la dernière cellule

Pourquoi ne pas copier directement la colonne entière ?

Code :

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

columns(j).copy

**patricktoulon** · 18/07/2019, 11h35

re
bonjour
les filtre et copy destination ils servent a quoi (faire la vaisselle)

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
 
Sub test()
    Dim c1 As Range, c2 As Range, sh1 As Worksheet, sh2 As Worksheet    'on declare des object range et sheets pour simplifier l'ecriture du code
    Set sh1 = Sheets("Extraction")    'on attribut le sheet extraction a sh1
    Set sh2 = Sheets("Analyse")    'on attribut le sheet analyse a sh2
    Set c1 = sh1.Cells.Find("Recettes - Missions", LookIn:=xlValues, lookat:=xlWhole)    'on trouve la cellule recettes - mission
    Set c2 = sh1.Cells.Find("Recettes - Hors Missions", LookIn:=xlValues, lookat:=xlWhole)    'on trouve la cellule recettes -hors  mission
    If Not c1 Is Nothing Then    'si c1 n'est pas rien (donc la cellule recettes missions)
        With sh1.Range(c1, sh1.Cells(Rows.Count, c1.Column).End(xlUp))    'on prends la cellule jusqu'a la derniere cellule remplie dans la meme colonne
            .AutoFilter Field:=1, Criteria1:="<>"    'ET!! on filtre les vides
            .Copy Destination:=sh2.Cells(Rows.Count, 1).End(xlUp)    'et enfin on copie dans le sheets analyse (sh2) dans la colonne"A" a partir de la premiere cellule dispo
            .AutoFilter
        End With
    End If
    ' et on fai t EXACTEMENT!!!! pareil avec la cellule hors missions
    If Not c2 Is Nothing Then    'si c1 n'est pas rien (donc la cellule recettes missions)
        With sh1.Range(c2, sh1.Cells(Rows.Count, c2.Column).End(xlUp))
            .AutoFilter Field:=1, Criteria1:="<>"
            .Copy Destination:=sh2.Cells(Rows.Count, 2).End(xlUp)
            .AutoFilter
        End With
    End If
End Sub

resultat dans Analyse
Nom : Capture.JPG
Affichages : 79
Taille : 52,8 Ko

**xszma** · 18/07/2019, 11h36

Halaster08 j'ai mis un exemple avec un fichier excel et la macro!
Si j'enlève le xlDown ça va le faire non?

Il a beaucoup de données normalement, et car je copie ces deux colonnes pour ensuite avoir qu'une seule colonne dans ma feuille Analyse, cette colonne serai nommé Recettes, et je faire du coup une adition des deux colonnes pour avoir le chiffre que je veux de la bonne colonne, tu comprends?

Merci de ta réponse!

**halaster08** · 18/07/2019, 11h45

Envoyé par xszma

Halaster08 j'ai mis un exemple avec un fichier excel et la macro!

Fichier que je n'ai pas ouvert notamment pour les raisons expliqués ici: https://www.developpez.net/forums/d8...s-discussions/

**xszma** · 18/07/2019, 11h50

Merci Patrick,

En faite il faudrai que mes deux recettes sur la feuille Extraction :

Nom : Recettesavant.PNG
Affichages : 77
Taille : 9,6 Ko

deviennent ensuite une seule recette sur ma feuille d'analyse :

Nom : Recettes.PNG
Affichages : 74
Taille : 6,0 Ko

**patricktoulon** · 18/07/2019, 11h56

re
voir titre

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
[Sub test2()
    Dim c1 As Range, c2 As Range, sh1 As Worksheet, sh2 As Worksheet, nextcel As Range   'on declare des object range et sheets pour simplifier l'ecriture du code
    Set sh1 = Sheets("Extraction")    'on attribut le sheet extraction a sh1
    Set sh2 = Sheets("Analyse")    'on attribut le sheet analyse a sh2
    Set c1 = sh1.Cells.Find("Recettes - Missions", LookIn:=xlValues, lookat:=xlWhole)    'on trouve la cellule recettes - mission
    Set c2 = sh1.Cells.Find("Recettes - Hors Missions", LookIn:=xlValues, lookat:=xlWhole)    'on trouve la cellule recettes -hors  mission
 
 
 
    If Not c1 Is Nothing Then    'si c1 n'est pas rien (donc la cellule recettes missions)
     Set nextcel = c1.EntireColumn.Find("*", , , , , xlPrevious) 'on prends la derniere ligne remplie dans une des deux colonnes
   With sh1.Range(c1, nextcel)    'on prends la cellule jusqu'a la derniere cellule remplie dans la meme colonne
            .Copy Destination:=sh2.Cells(Rows.Count, 1).End(xlUp)    'et enfin on copie dans le sheets analyse (sh2) dans la colonne"A" a partir de la premiere cellule dispo
        End With
    End If
    ' et on fai t EXACTEMENT!!!! pareil avec la cellule hors missions
    If Not c2 Is Nothing Then    'si c1 n'est pas rien (donc la cellule recettes missions)
        Set nextcel = c2.EntireColumn.Find("*", , , , , xlPrevious) 'on prends la derniere ligne remplie dans une des deux colonnes
   With sh1.Range(c2, nextcel)
            .Copy Destination:=sh2.Cells(Rows.Count, 2).End(xlUp)
        End With
    End If
End Sub

ce la dit
par la methode globale range ou autofilter

j'espere que c'est pas quelque chose qui est fait régulièrement sinon on va avoir un probleme l'ors du prochain ajout

sauf si on prend le xl(up) ,,,previous des colonnes "A:B" du sheets "Annalyse"

**patricktoulon** · 18/07/2019, 12h08

ok sur une colonne

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
Sub test2()
    Dim c1 As Range, c2 As Range, sh1 As Worksheet, sh2 As Worksheet, nextcel As Range   'on declare des object range et sheets pour simplifier l'ecriture du code
    Set sh1 = Sheets("Extraction")    'on attribut le sheet extraction a sh1
    Set sh2 = Sheets("Analyse")    'on attribut le sheet analyse a sh2
    Set c1 = sh1.Cells.Find("Recettes - Missions", LookIn:=xlValues, lookat:=xlWhole)    'on trouve la cellule recettes - mission
    Set c2 = sh1.Cells.Find("Recettes - Hors Missions", LookIn:=xlValues, lookat:=xlWhole)    'on trouve la cellule recettes -hors  mission
    If Not c1 Is Nothing Then    'si c1 n'est pas rien (donc la cellule recettes missions)
        Set nextcel = sh1.Range(c1, sh1.Cells(Rows.Count, c1.Column).End(xlUp))    'on prends la derniere ligne remplie dans une des deux colonnes
        With sh1.Range(c1, nextcel)    'on prends la cellule jusqu'a la derniere cellule remplie dans la meme colonne
            .Copy Destination:=sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1)    'et enfin on copie dans le sheets analyse (sh2) dans la colonne"A" a partir de la premiere cellule dispo
        End With
    End If
    ' et on fai t EXACTEMENT!!!! pareil avec la cellule hors missions
    If Not c2 Is Nothing Then    'si c1 n'est pas rien (donc la cellule recettes missions)
        Set nextcel = sh1.Range(c2, sh1.Cells(Rows.Count, c2.Column).End(xlUp))    'on prends la derniere ligne remplie dans une des deux colonnes
        With sh1.Range(c2, nextcel)
            .Copy Destination:=sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End With
    End If
End Sub

si tu veux enlever le header c'est

Code :

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

With sh1.Range(c1.offset(1), nextcel)

et pareil por l'autre colonne

Code :

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

With sh1.Range(c2.offset(1), nextcel)

**xszma** · 18/07/2019, 12h16

Super intéressant cette méthode, j'ai un peu de mal avec vba , merci beaucoup Patrick !

Je te met le résultat que j'obtient après le lancement de la macro test2 sur la bonne feuille Analyse :
Nom : test.PNG
Affichages : 70
Taille : 8,4 Ko

Nom : test.PNG
Affichages : 70
Taille : 8,4 Ko

Nom : test2.PNG
Affichages : 71
Taille : 9,3 Ko

Presque!!!

**patricktoulon** · 18/07/2019, 12h20

re donc on est bon
si tu veux enlever les header(cellules bleues) relis le post 8

**xszma** · 18/07/2019, 14h03

Oui ça marche super merci!

Mais je voulais ce résultat, je pense que c'est assez compliqué à réalisé non ?

Nom : Recettes.PNG
Affichages : 66
Taille : 6,0 Ko

Merci de ton aide Patrick!

**patricktoulon** · 18/07/2019, 14h29

de rien
la prochaine fois essaie d'être plus clair dans tes demandes c'est pas toujours facile je sais mais plus tôt ta demande est comprise plus vite tu a une solution
et moins de post pour une question aussi simple que celle ci
clique résolu si ca te convient
au plaisir

Copie qui s'arrête via code vb [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager