Copie des lignes vers fichier fermé???

Le 10/05/2011 à 11:46

Bonjour,

Je dispose d'une macro me permettant de valider des lignes et de les copier vers un autre classeur Excel.

  Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim dlg As Integer
    If Not Intersect(Target, Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    With Target
        If Range("J" & .Row) <> "" And Range("K" & .Row) <> "" And Range("L" & .Row) <> "" And Range("M" & .Row) <> "" And Range("N" & .Row) <> "" And Range("O" & .Row) <> "" Then
        dlg = Workbooks("consolide.xlsx").Sheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
        Range("A" & .Row & ":N" & .Row).Copy Workbooks("consolide.xlsx").Sheets("CI").Range("A" & dlg)
        End If
    End With
    End If
    Cancel = True
    End Sub

Le problème qui se pose, c'est que le fichier "Consolide" doit être obligatoirement ouvert de manière à copier les lignes.

Existerait il une solution afin de:

-Soit cacher le fichier consolide; c'est à dire faire en quelque sorte qu'il n'apparaisse pas pour l'utilisateur.

-Ou bien faire en sorte qu'il ne s'ouvre pas du tout mais que les lignes soient copiées quand même.

Merci

Le 10/05/2011 à 13:22

Bonjour,

le fichier "consolide.xlsx" est-il dans le même répertoire que le fichier actif ?

sinon, il faut le chemin complet (C:\......)

à te relire

Amicalement

Claude

Le 10/05/2011 à 14:31

Bonjour,

Le fichier est bien dans le même répertoire, mais j'ai déjà essayé, sans succès.

Existe t-il une autre manipulation?.??

Le 10/05/2011 à 14:57

re,

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Chemin$, NomFichier$
Dim Lg%, Plg As Range
    Chemin = ActiveWorkbook.Path & "\"
    NomFichier = "consolide.xlsx"           'à régler
    Application.ScreenUpdating = False

    If Not Intersect(Target, Columns("a")) Is Nothing Then
        Lg = Target.Row
        Set Plg = Union(Cells(Lg, "j"), Cells(Lg, "k"), Cells(Lg, "L"), _
        Cells(Lg, "m"), Cells(Lg, "n"), Cells(Lg, "o"))

        If Application.CountA(Plg) = 6 Then
            Range("a" & Lg & ":n" & Lg).Copy
                On Error GoTo Fin
            Workbooks.Open Filename:=Chemin & NomFichier
            Sheets("CI").Range("a65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            ActiveWorkbook.Save
            ActiveWorkbook.Close
            MsgBox ("Opération réussie !")
        End If
    End If
Exit Sub
Fin: MsgBox ("fichier non trouvé, l'opération à échouer !")
End Sub

Claude

Le 11/05/2011 à 14:16

Merci beaucoup, ca ressemble beaucoup à ce que je cherchai.

Dernière petite chose: serait il possible, plutôt que de copier les lignes une par une, de copier vers le fichier consolide toutes les lignes complétées de la colonne A à N d'un seul double clique sur la première cellule de la dernière ligne complétée????

Le fichier complet comporte 50 lignes, donc je vois mal les utilisateurs double cliquer 50fois.

Est ce possible de modifier le code dans ce sens???

Merci encore.

Emilien

Le 11/05/2011 à 15:38

Bonjour,

La question était mal posée !

plus rien à voir avec un double clic.

Il faudrait déjà filtrer les colonnes "J:O" remplies et

copier le résultat de ce filtre dans le fichier "consolide" (à la suite)

Pour éviter de doublonner,

il faudrait aussi ajouter une colonne "Vu consolide" (par exemple)

Envoie le fichier avec sa structure réelle (quelques lignes)

à te relire

Amicalement

Claude

Le 11/05/2011 à 15:52

Merci pour votre réponse.

Je reformule ma question:

J'ai essayé en vain de faire ceci:

-Les colonnes de A à J sont par défaut remplies.

-Les colonnes de K à O sont à remplir.

-L'utilisateur n'est pas forcé de remplir toutes les lignes (de 2 à 51) en une fois.

-Dès lors qu'il a fini de remplir quelques lignes (à partir de 2), en double cliquant sur la première cellule de la dernière ligne remplie, l'intégralité des lignes et colonnes au dessus de cette cellule sont copiées vers un fichier annexe "consolide".

La seule chose qui me manque dans votre code consiste à pouvoir copier plusieurs lignes en une fois.

J'ai joint ci-dessous le fichier original.

Merci beaucoup

Cdt.

Emilien

43ecarts-cc.xlsm (23.77 Ko)
Le 11/05/2011 à 16:26

Bonjour

Cela fait plusieurs fils où l'on parle de ce sujet....

Je t'avais en outre proposé sur ce fil de mettre un X dans une colonne plutôt qu'une case à cocher -> https://forum.excel-pratique.com/excel/case-a-cocher-pour-validation-et-deplacement-de-ligne-t23119.html

De cette sorte un bête bouton à cliquer pouvait faire le travail.

Autres fils : https://forum.excel-pratique.com/post131172.html#p131172 et https://forum.excel-pratique.com/post130786.html#p130786

Tu ne m'as pas donné réponse et surtout tu parlais de passer d'une feuille à l'autre plutôt que d'un classeur à l'autre.

Amicalement

Le 11/05/2011 à 22:25

Bonsoir, salut Dan,

Double clic ou bouton, reste le problème des doublons !

ici, j'ai ajouté la colonne "P", comme "Vu" si ligne copiée

tu peux donc lancer la macro à tous moment, les "Vu" ne seront

plus copiés.

le fichier "consolide" est sensé être fermé et dans le même répertoire,

la feuille concernée est "CC" (au lieu de "CI" précédemment).

Sub TransfertLignes()
Dim Chemin$, NomFichier$
Dim Lg%, Plg As Range
    Chemin = ActiveWorkbook.Path & "\"
    NomFichier = "consolide.xlsx"
        Application.ScreenUpdating = False
        Lg = Range("a65536").End(xlUp).Row

    '--- NomFichier est sensé être fermé ---
        On Error Resume Next
        Workbooks(NomFichier).Close False
        On Error GoTo 0

    '--- filtre colonnes "J:O" remplies et colonne "P" vide ---
    Range("t2") = "=AND(COUNTA(j2:o2)=6,p2="""")"
    Range("a1:p" & Lg).AdvancedFilter Action:=xlFilterInPlace, _
    CriteriaRange:=Range("t1:t2"), Unique:=False
    Range("t2").ClearContents
    '---
    Set Plg = Range("p1:p" & Lg).SpecialCells(xlCellTypeVisible)
        Plg = "Vu"
    If Application.CountA(Plg) > 1 Then
        Range("a2:o" & Lg).SpecialCells(xlCellTypeVisible).Copy

            On Error GoTo Fin       'si erreur Chemin
        Workbooks.Open Filename:=Chemin & NomFichier
            With Sheets("CC")
                .Paste .Range("a65536").End(xlUp)(2)
            End With
        Application.CutCopyMode = False
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        MsgBox ("Opération réussie !")
    Else
        MsgBox ("Rien à copier !")
    End If
            On Error Resume Next
            ActiveSheet.ShowAllData
Exit Sub
Fin:     MsgBox ("fichier non trouvé, l'opération à échouer !")
End Sub

Amicalement

Claude

84eboiteux-fichier-2.xlsm (26.43 Ko)
Le 12/05/2011 à 12:05

C'est parfait merci bcp Claude et Dan..

Ca m'aide énormément sachant que jusqu'alors la consolidation des données me prenait plusieurs heures.

A bientôt

Cdt.

Emilien

Le 12/05/2011 à 12:52

Bonjour,

n'oublie pas la petite formalité

Rechercher des sujets similaires à "copie lignes fichier ferme"