Impossibilité de copier/coller une colonne en lien avec la cellule active

Le 01/05/2019 à 22:30

Bonjour à tous,

C'est mon tout premier message sur le forum et je suis débutant en excel et VBA, merci d'être indulgent avec moi !

J'ai écris une macro pour permettre que :

Quand une cellule est active et qu'on lance la macro celle-ci va trouvé l'entête de la colonne pour ouvrir une feuille comportant le nom de l'entête, l'ouvrir et dans cette autre feuille elle va chercher la colonne qui correspond au nom de la cellule active de départ.

Une fois cette colonne trouvé, elle va la copier pour la coller dans une autre feuille, et ce schéma pour 4 colonnes et 2 feuilles au total

Je sais pas si j'ai été très claire dans mes explications ... Mais là où je bloque c'est que la macro s'arrêter à la première ligne permettant d'allez sur la première colonne à copier "Sheets(t1).Range(t4).Select" mais je pense que cela vient de la variable t4 qui ne ce définit pas correctement

Je vous laisse observé ci-dessous les lignes de code que j'ai bidouillé ...

Merci d'avance.

Sub Macro3()
'
' Macro3 Macro
'
t0 = ActiveCell.EntireColumn.Cells(1, 1)
t1 = t0 + " Avant_livraison"
t2 = t0 + " Après_livraison"

Dim plage As Range

'On recherche dans la feuille "avant livraison"

Set plage = Sheets(t1).Range("2:2")
Monchiffre = ActiveCell

For Each Cell In plage
    If Cell.Value = Monchiffre Then
    t5 = Cell.Address
    t3 = Range(t5).Column
    t4 = Range(Cells(t3, 2), Cells(t3, 5000))

'On cherche et copie/colle la première colonne du cumul
    Sheets(t1).Range(t4).Select
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("individuel").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'On cherche et copie/colle la première colonne des matricules
    Sheets(t1).Range("C2:C5000").Select
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("individuel").Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    Next Cell

'On recherche dans la feuille "après livraison"

Set plage = Sheets(t2).Range("2:2")
Monchiffre = ActiveCell

For Each Cell In plage
    If Cell.Value = Monchiffre Then
    t5 = Cell.Address
    t3 = Range(t5).Column
    t4 = Range(Cells(t3, 2), Cells(t3, 5000))

'On cherche et copie/colle la deuxième colonne du cumul
    Sheets(t2).Range(t4).Select
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("individuel").Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'On cherche et copie/colle la deuxième colonne des matricules
    Sheets(t2).Range("C2:C5000").Select
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("individuel").Range("D1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    Next Cell

End Sub

[EDIT] Je rajoute le fichier correspondant, je l'ai réduit pour pouvoir rentré dans la taille maximum

[EDIT 2] Décidément je fatigue, j'ai oublié qu'on partait de la feuille "Ecarts" en sélectionnant une cellule ce trouvant en colonne B ou I pour terminer en feuille "Individuel" à la fin de la macro.

10comparaison-cumuls.xlsm (0.99 Mo)
Le 01/05/2019 à 23:33

Slt Yarond et

essaie comme ca,

Sub Macro3()
'
' Macro3 Macro
'
t0 = ActiveCell.EntireColumn.Cells(1, 1)
t1 = t0 + " Avant_livraison"
t2 = t0 + " Après_livraison"

Dim plage As Range

'On recherche dans la feuille "avant livraison"

Set plage = Sheets(t1).Range("2:2")
Monchiffre = ActiveCell

For Each Cell In plage
    If Cell.Value = Monchiffre Then
    t5 = Cell.Address
    t3 = Range(t5).Column

    Sheets(t1).Activate
    Sheets(t1).Range(Cells(t3, 2), Cells(t3, 5000)).Copy
    Sheets("individuel").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Application.CutCopyMode = False

'On cherche et copie/colle la première colonne des matricules
    Sheets(t1).Range("C2:C5000").Copy

    Sheets("individuel").Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Application.CutCopyMode = False
    End If

    Next Cell

'On recherche dans la feuille "après livraison"

Set plage = Sheets(t2).Range("2:2")
Monchiffre = ActiveCell

For Each Cell In plage
    If Cell.Value = Monchiffre Then
    t5 = Cell.Address
    t3 = Range(t5).Column

'On cherche et copie/colle la deuxième colonne du cumul
    Sheets(t2).Activate
    Sheets(t2).Range(Cells(t3, 2), Cells(t3, 5000)).Copy

    Sheets("individuel").Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'On cherche et copie/colle la deuxième colonne des matricules
    Sheets(t2).Range("C2:C5000").Copy

    Sheets("individuel").Range("D1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Application.CutCopyMode = False

    End If

    Next Cell

End Sub

Il faut aussi verifier s‘il colle bien les donnees dans les bonnes lignes!

Le 01/05/2019 à 23:54

Merci pour le bienvenu et pour la réponse si rapide !

Alors j'ai modifié et réessayé mais quand je lance la macro, il n'y a rien qui ce passe, je n'ai plus d'erreur ou autre, mais j'ai littéralement plus rien qui s'affiche, aucune fenêtre qui s'ouvre, aucune feuille ou cellule qui change, tout reste à l'identique, même sur la feuille "individuel" ...

Je remet le fichier modifié du coup, si tu sais d'où ça peut venir, je n'ai jamais eu ça ...

Alors je retire ce que je viens de dire, j'ai testé la macro sur la colonne I, ça essai de passer sur la feuille individuel, mais ça "clignote" et ça fait planter excel mon excel ... Je pense pas avoir un ordinateur sur vieux que ça quand même

5comparaison-cumuls.xlsm (710.05 Ko)
Le 01/05/2019 à 23:59

Re, essaie la macro modifiee en haut, il colle bien les donnees mais en haut dans la premiere ligne de l‘onglet „individuel“ par exemple

Le 02/05/2019 à 00:17

Effectivement, cela ne me donnait rien car sans comprendre pourquoi les deux premières feuilles étaient vidés ...

Mais il plante toujours lorsque j'utilise la macro sur la colonne I, et tout ce colle uniquement sur la première ligne ...

Mon problème de base est résolu, mais je reste toujours coincé sans pouvoir avancé, et je t'avoue que je sais pas d'où viens l'erreur du coup ...

Je met quand même en résolu ?

Le 02/05/2019 à 00:22

Re,

si tu veux par exemple qu'il colle les données aprés la dernière ligne de la colonne A, alors tu fais comme suivant:

Dim lRow as Long ' on declare une variable
lRow = Cells(Rows.Count, 1).End(xlUp).Row ' on calcule la première céllule non vide dans la colonne A

' et aprés tu remplcae

Sheets("individuel").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

par

Sheets("individuel").Range("A" & lRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

pour la colonne I je vais jetter un coup d'oeil

Bon il faut changer cette ligne

t0 = ActiveCell.EntireColumn.Cells(1,1)

en

t0 = ActiveCell.EntireColumn.Cells(1)
Le 02/05/2019 à 08:21

Merci beaucoup !

Le problème est résolu et la macro marche correctement, j'ai juste la colonne B de la feuille écart qui n'est pas la bonne à ce coller, mais sinon tous le reste est good ! Merci encore

Rechercher des sujets similaires à "impossibilite copier coller colonne lien active"