Extraction puis copie en double Pourquoi ?

Bonjour a tous

je reviens vers vous car de nouveau un probleme

Donnes du probleme

J ai un fichier avec une ligne de données journalieres

Ce fichier est ouvert tous les jours manuellement "activite"

Dans ce fichier initial "Recap Zone" ligne "A15 a N15" j envoi automatiquement par un bouton vers un fichier recap annuel2/Recap Zone

Et la ca me copie 2 fois les donnees au lieu d une seule fois

Code

fichier "activite"

Dim plg20 As Range

Set plg20 = ThisWorkbook.Worksheets("Recap Zone").Range("A15:N15")

Workbooks.Open ("Y:\CCER\REMPLIR le MATIN\Activité aérienne\recap annuel2.xlsx")

With Worksheets("Recap Zone")

Lig = .Cells(.Rows.Count, 1).End(xlUp).Row

.Range(.Cells(Lig + 2, 1), .Cells(Lig + plg20.Rows.Count, plg20.Columns.Count + 1)).Value = plg20.Value

End With

merci

Bonjour Sat, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim plg20 As Range 'déclare la variable plg20
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CS = ThisWorkbook 'définit la classeur source CS
Set OS = CS.Worksheets("Recap Zone") 'définit l'onglet source OS
Set plg20 = OS.Range("A15:N15") 'définit la plage plg20
Set CD = Workbooks.Open("Y:\CCER\REMPLIR le MATIN\Activité aérienne\recap annuel2.xlsx") 'définit le classeur destination CD (en l'ouvrant)
Set OD = CD.Worksheets("Recap Zone") 'définit l'onglet destination OD
Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(2, 0) 'définit la cellule de destination DEST
DEST.Resize(PL.Rows.Count, PL.Columns.Count).Value = plg20.Value 'récupère dans la cellule DEST redimensionnée, les valeur de la plage plg20
End Sub

Bonjour,

Si vous avez de la copie en double, cela signifie a priori que votre plage cible est 2 fois plus grande que votre plage source.

Essayer ce code

Sub copie()

    Dim plg20 As Range
    Set plg20 = ThisWorkbook.Worksheets("Recap Zone").Range("A15:N15")

    Workbooks.Open ("Y:\CCER\REMPLIR le MATIN\Activit? a?rienne\recap annuel2.xlsx")

    With Worksheets("Recap Zone")
        Lig = .Cells(.Rows.Count, "A").End(xlUp).Row + 2
        .Cells(Lig, "A").Resize(plg20.Rows.Count, plg20.Columns.Count).Value = plg20.Value
    End With

End Sub

merci pour ce super code

bravo a vous

Rechercher des sujets similaires à "extraction puis copie double pourquoi"