Copie de colonne d'un classeur à un autre avec décalage de ligne

mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention -
mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention - 2 juil. 2017 à 21:45

Bonjour,

Je suis arrêté dans le code que j'ai récupérer sur le net et que je ne comprends pas bien
Mon objectif est de copier 3 colonnes, je n'en mets qu'une ici, d'un classeur vers un autre mais avec un décalage de ligne à l'arrivée.
Mes données viennent de textbox d'un formulaire dont le bouton de commande du code joint ici récupère les infos pour lancer la copie.
Voici le code:


Private Sub cbImporter_Click()
Dim WkbSrce As Workbook
Dim WkbDest As Workbook
Dim FeuilSrce As Worksheet
Dim chemfic As String
Dim onglet As String
Dim celNom As Range
Dim celLot As Range
Dim celTantG As Range
Dim nblot As Integer
Dim lgfin As Long
Const decal = 6
Dim col As char

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    nblot = tbx_nblot
    onglet = tbx_onglet.Text
    celLot = tbx_celLot.Text
    celNom = tbx_celNom.Text
    celTantG = tbx_celTantG.Text

    lgfin = decale + nblot
    
    'Workbooks.Open Filename:=chemfic
    Set WkbSrce = Workbooks.Open(chemfic)
    Set FeuilSrce = WkbSrce.Sheets(onglet)

    Set WbkDest = ActiveWorkbook
    Sheets("Presence").Activate
    
    WbkSrce.Activate
    FeuilSrce.Select

        '----- (les 2 classeurs sont ouverts) -----
            'copie Lots
    With FeuilSrce
        col = Column(celLot)
        .Range(celLot : col&lgfin).Copy
    End With
    With WbkDest
        .Range("C6").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    End With
                       '-----------code d origine---------
   With WbkSrce
        .Range("B137:BB137").Copy
    End With
    With WbkDest
        .Range("A65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    End With

1) je ne suis pas sur de la ligne en gras, cette ligne ouvre-t-elle le classeur avant?

2) la ligne Range en italique: celLot correspond à l'adresse de la 1ere colonne à copier (ex: C4). nblot donne le nombre de lignes à copier auquel il faut ajouter un décalage (6) pour atteindre la bonne ligne à destination. J'ai modifié le code d'origine mais j'ai une erreur (fin d'instruction attendue).

3) En plus, je ne comprends pas la ligne Range du code d'origine: où est indiquée la feuille et la cellule de destination. Celle à partir de laquelle on va coller ?

Merci de votre aide

Afficher la suite

A voir également:

Copie de colonne d'un classeur à un autre avec décalage de ligne
Partage de photos en ligne - Guide
Déplacer colonne excel - Guide
Trier colonne excel - Guide
Copie cachée - Guide
Aller à la ligne excel - Guide

5 réponses

Réponse 1 / 5

Kalissi Messages postés 218 Date d'inscription Statut Membre Dernière intervention 20

Bonjour,

Quelques informations :

Private Sub cbImporter_Click()

    Const decal = 6

    Dim WkbSrce As Workbook, WkbDest As Workbook
    Dim FeuilSrce As Worksheet
    Dim chemfic As String, onglet As String
    Dim celNom As Range, celLot As Range, celTantG As Range
    Dim nblot As Integer, lgfin As Long
    Dim col As char
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    nblot = CInt(tbx_nblot.Text)
    onglet = CStr(tbx_onglet.Text)
    ' Ici pour affecter une plage à un objet, il faut utiliser l'instruction Set
    Set celLot = Range(CStr(tbx_celLot.Text))
    Set celNom = Range(CStr(tbx_celNom.Text))
    Set celTantG = Range(CStr(tbx_celTantG.Text))

    lgfin = decale + nblot
    
    'Workbooks.Open Filename:=chemfic
    
    ' Ici il y a ouverture d'un classeur
    Set WkbSrce = Workbooks.Open(chemfic)
    ' Ici il y a attachement d'un objet sur une feuille
    Set FeuilSrce = WkbSrce.Sheets(onglet)

    ' Problème : Ici le classeur actif est WkbScre, voir 2 instructions avant
    ' Alors pourquoi attacher l'objet WkbDest qui semble être le fichier de destination
    Set WbkDest = ActiveWorkbook
    Sheets("Presence").Select
    
    WbkSrce.Activate
    FeuilSrce.Select

        '----- (les 2 classeurs sont ouverts) -----
            'copie Lots
    With FeuilSrce
        col = Column(celLot)
        .Range(celLot & ":" & col & lgfin).Copy
    End With
    
    With WbkDest
        ' -Ici le feuille "Presence" a été sélectionné préalablement
        '  donc la copie sera effectué sur cette feuille
        .Range("C6").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    End With
    
                       '-----------code d origine---------
   ' -Une nouvelle copie, et on ne copie qu'une seule
   '  ligne (137) de colonne B à colonne BB ???
   ' -Aucune feuille n'est spécifié, donc dans les deux classeur
   '  c'est la feuille active qui est ciblé
   With WbkSrce
        .Range("B137:BB137").Copy
    End With
    
    With WbkDest
        .Range("A65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    End With

End Sub

mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention 53

Bonsoir Kalissi,

je ne comprends pas pourquoi on dois convertir le texte (ex:A4) puis faire range(A4) et finir par l'affecter à sa variable ? c'est un texte, à la base, qui est entré ...

WkbDest est effectivement le classeur de destination donc je le prépare par cette ligne

    
    Set WbkDest = ActiveWorkbook
    Sheets("Presence").Select

Enfin, au moment de coller la copie, la feuille sélectionnée avant c'est "FeuilSrce " pas "Presence". ça j'ai du mal à comprendre comment est fait le distinguo.

merci de votre aide

Réponse 2 / 5

mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention 53

Désolé, mais les modifications qu'a fait Kalissi n'ont rien données de bon.
Les ranges ne conviennent pas. Alors j'ai tout refait mais il y a un blocage au niveau de l'ouverture des classeurs pour copier.


Private Sub cbImporter_Click()

Const decal As Integer = 6

Dim WkbSrce As Workbook
Dim WkbDest As Workbook
Dim FeuilSrce As Worksheet
Dim chemfic As String
Dim onglet As String
Dim celNom As String
Dim celLot As String
Dim celTantG As String
Dim nblot As Integer
Dim lgfin As Long
Dim col As String


    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Set WkbDest = ActiveWorkbook
    'Sheets("Presence").Activate
    
    MsgBox (ActiveWorkbook.Name)
    
    nblot = CInt(tbx_nblot.Text)
    onglet = CStr(tbx_onglet.Text)
    chemfic = CStr(tbx_chemfic.Text)
    
    col = Left(tbx_celLot.Text, 1)

    celLot = tbx_celLot.Text
    celNom = tbx_celNom.Text
    celTantG = tbx_celTantG.Text

    lgfin = decal + nblot

    Set WkbSrce = Workbooks.Open(chemfic)
   
        '-----  copie Lots -----

        WkbSrce.Sheets(onglet).Range(celLot & ":" & col & lgfin).Copy

   '---------jusque là ça marche !

        WkbDest.Activate
        WkbDest.Sheets("Presence").Range("C6").PasteSpecial (xlPasteValues)

Pour la ligne en gras on voit bien que les colonnes sont sélectionnées dans les 2 classeur mais rien n'est collé et le carré de sélection de copie est toujours actif.

Quelqu'un serait-il m'aider svp?

Réponse 3 / 5

Kalissi Messages postés 218 Date d'inscription Statut Membre Dernière intervention 20

Bonjour,

Idéalement, positionne toi avant de coller ...

    WbkDest.Activate
    Sheets("Presence").Range("C6").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

Le range de positionnement peut être dynamique.

Y a-t-il une raison particulière d'utiliser le "PasteSpecial" ?

Explication :

Dans ta première définition :

Dim celNom As Range
Dim celLot As Range
Dim celTantG As Range

Ces variables sont définis comme étant des objets "plage" (Range).
Or un objet "plage" (range) ne peut recevoir une affectation simple.

celNom = "A4"

on doit utiliser l'instruction Set pour affecter une ou plusieurs cellule(s) à un objet "plage" (Range).

Set celNom = Range("A4")
celnom.Select
Set celNom = Range("A4:A40")
celNom.Select

mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention 53

Y a-t-il une raison particulière d'utiliser le "PasteSpecial" ?

en fait, il y a des ligne de couleur et en copiant les couleurs sont emportées aussi ce qui détruit tout à à destination.

C'est pourquoi, j'ai tout recommencé, mais sans succès.
j'ai ajouter ton code mais toujours pas de copie:


Private Sub cbImporter_Click()

Const decal As Integer = 6

Dim WkbSrce As Workbook
Dim WkbDest As Workbook
Dim FeuilSrce As Worksheet
Dim chemfic As String
Dim onglet As String
Dim celNom As String
Dim celLot As String
Dim celTantG As String
Dim nblot As Integer
Dim lgfin As Long
Dim col As String
Dim plage As String

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    nblot = CInt(tbx_nblot.Text)
    onglet = CStr(tbx_onglet.Text)
    chemfic = CStr(tbx_chemfic.Text)
    
    col = Left(tbx_celLot.Text, 1)
    celLot = tbx_celLot.Text
    celNom = tbx_celNom.Text
    celTantG = tbx_celTantG.Text

    lgfin = decal + nblot
    plage = celLot & ":" & col & lgfin
    
    Set WkbDest = ActiveWorkbook            'modif
    Set WkbSrce = Workbooks.Open(chemfic)   'modif
    
    WkbSrce.Sheets(onglet).Range(celLot & ":" & col & lgfin).Copy
    
    WbkDest.Activate
    Sheets("Presence").Range("C6").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

erreur 424 sur la ligne en gras "objet attendu"

Réponse 4 / 5

Kalissi Messages postés 218 Date d'inscription Statut Membre Dernière intervention 20

Bonjour,

Voilà, j'ai testé le code, simuler devrais-je dire.
J'ai trouvé l'erreur ...

    nblot = 5 'CInt(tbx_nblot.Text)
    Onglet = "Fle" 'CStr(tbx_onglet.Text)
    ChemFic = "C:\Document\VBA\Excel\UnClasseur.xls" 'CStr(tbx_chemfic.Text)
    NomFic = "UnClasseur.xls"
    
    col = "B" 'Left(tbx_celLot.Text, 1)
    celLot = "C" 'tbx_celLot.Text
    celNom = "D" 'tbx_celNom.Text
    celTantG = "E" 'tbx_celTantG.Text


    LgFin = decal + nblot
' ... Ici lors de la définition de la plage à copier il manque la colonne
'     remplace le chiffre LgDeb par la bonne position
    LgDeb = 1
    Plage = celLot & LgDeb & ":" & col & LgFin
    
    Set WkbSrce = ActiveWorkbook            'modif
    Set WkbDest = Workbooks.Open(ChemFic)   'modif
    
    WkbSrce.Sheets(Onglet).Range(Plage).Copy
    
'... ici, je ne m'explique pas encore pourquoi
'    l'instruction WkbDest.Activate ne fonctionne pas ...
'    j'ai pourtant déjà vu cette erreur ...
    Workbooks(NomFic).Activate
    
    Sheets("Presence").Range("C6").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

Ceci dit, je ne connais pas exactement ce que tu veux copier,
mais avec ces informations ça devrait fonctionner ...

K

mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention 53

Bonjour Kalissi,

J'avais laissé tombé alors j'ai du m'y replonger. Merci de ton aide!
Je cherche en fait à copier des noms et des valeurs d'un fichier excel pour les copier dans un nouveau fichier excel mais à un emplacement différent (cellule et feuille).
je reviens dès que j'ai recopié ton code...

mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention 53

là il y a eu des copies erronées: ça a copié dans le même fichier, dans la bonne colonne mais pas dans la bonne ligne et feuille.
Comme tu as inversé dest et srce je suis obligé d'adapter.

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 5

mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention 53

grâce à ta proposition j'ai réussi la copie comme ça:


    Set WkbDest = ActiveWorkbook
    Set WkbSrce = Workbooks.Open(chemfic)
                                    'copie dans fichier source
    WkbSrce.Sheets(onglet).Range(plage).Copy
                                    'colle dans fichier destination
    WkbDest.Activate
    Sheets("Presence").Range("C6").Select   'va coller dans fichier destination à partir de cellule "C6"
    ActiveSheet.Paste.Value
    
    'WkbSrce.Sheets(onglet).Range(plage).Copy _
    '    WkbDest.Sheets("Presence").Range("C6").Value
        
    Application.CutCopyMode = False

Le problème c'est que j'ai à destination le formatage de la source (couleur et bordures).
Je sais qu'il faut mettre "value" quelque part pour empêcher cela, mais ou donc, svp?
J'ai essayé

Range(page).copy.value

Range(page).value.copy

sans succès.

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention 1 584

bonjour, peut-être ainsi?

WkbSrce.Sheets(onglet).Range(plage).Copy
WkbDest.Sheets("Presence").Range("C6").PasteSpecial xlPasteValues

mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention 53 > yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention

Merci yg_be c'est impeccable !
néanmoins tu peux m'indiquer comment faire une copie mais sans ouvrir le fichier source stp ? ou comment le fermer après la copie stp.

merci

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention 1 584 > mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention

je ne pense pas qu'il soit possible de le lire sans l'ouvrir.
pour le fermer, je suggère (après le Paste):

WkbSrce.Close

mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention 53

Super ça a marché! j'ai essayé plein de truc mais sans succès.

A destination la zone copiée reste en surbrillance malgré:

Application.CutCopyMode = False

c'est bien cela qui permet de désélectionner le cadre de copie, non?!
j'ai essayé un

range("A4").select

mais le code plante
Peux-tu m'éclairer stp?

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention 1 584 > mod77 Messages postés 1284 Date d'inscription Statut Membre Dernière intervention

as-tu supprimé tous les

.Activate

.Select

Discussions similaires

Copier un lien instagram

Votre réponse

Discussions similaires