Copie cellule dans autre classeur

Bonjour a tous,

Je souhaite copier les cellules contenant des chiffres du fichier source vers le fichier destination en mettant un chiffre par colonne.

J'ai commencé un bout de code avec internet, il fonctionne mais copie la feuille entiere. Je ne trouve pas comment copier seulement les cellules ?

Merci d'avance pour votre aide.

Bonjour,

Essaie comme cela

Private Sub Bouton1_Cliquer()
Dim Var_Chemin As String
Dim FichierS As Workbook, FichierD As Workbook
Dim ColD As Integer
    ColD = 1
    Var_Chemin = "C:\Users\steph\Documents\Copie.xlsx"
    Set FichierS = ActiveWorkbook
    Workbooks.Open Var_Chemin, 0, ReadOnly:=False
    Set FichierD = ActiveWorkbook
    For Each Cel In FichierS.Sheets("Info").UsedRange
        If Cel.Value <> "" Then
            Cel.Copy FichierD.Sheets("Colle").Cells(2, ColD)
            ColD = ColD + 1
        End If
    Next Cel
End Sub

A+

Bonsoir frangy,

Je me suis mal exprimé. Dans le classeur source il y aura d'autres valeurs de saisie mais je veux copier seulement les cellules B4, D8, F12 et H18.

En fait chaque jour je vais saisir des données dans ces cellules et je voudrais que a la fin de ma saisie en appuyant sur le bouton cela copie la B4 dans la colonne A du classeur destination, la D8 en colonne B, la F12 en colonne C et la H18 en colonne D. Le jour suivant la même chose mais sur la ligne suivante du classeur destination.

Alors comme cela

Private Sub Bouton1_Cliquer()
Dim Var_Chemin As String
Dim FichierS As Workbook, FichierD As Workbook
Dim ColD As Integer, i As Integer
Dim LigneD As Long
Dim Add
    ColD = 1
    Var_Chemin = "C:\Users\steph\Documents\Copie.xlsx"
    Set FichierS = ActiveWorkbook
    Workbooks.Open Var_Chemin, 0, ReadOnly:=False
    Set FichierD = ActiveWorkbook
    LigneD = FichierD.Sheets("Colle").Range("A" & Rows.Count).End(xlUp).Row + 1
    Add = Array("B4", "D8", "F12", "H18")
    With FichierS.Sheets("Copie")
        For i = 0 To UBound(Add)
            .Range(Add(i)).Copy FichierD.Sheets("Colle").Cells(LigneD, ColD)
            ColD = ColD + 1
        Next i
    End With
End Sub

A+

Cela fonctionne a merveille. Merci beaucoup.

Pourrais tu m'expliquer un peu, je ne comprend pas tout.

    Private Sub Bouton1_Cliquer()
    Dim Var_Chemin As String
    Dim FichierS As Workbook, FichierD As Workbook
    Dim ColD As Integer, i As Integer
    Dim LigneD As Long
    Dim Add
        ColD = 1 '???
        Var_Chemin = "C:\Users\steph\Documents\Copie.xlsx" 'Chemin d'accés no soucy
        Set FichierS = ActiveWorkbook 'Ca je comprend
        Workbooks.Open Var_Chemin, 0, ReadOnly:=False 'Idem
        Set FichierD = ActiveWorkbook 'Compris
        LigneD = FichierD.Sheets("Colle").Range("A" & Rows.Count).End(xlUp).Row + 1 'Premiere ligne vide
        Add = Array("B4", "D8", "F12", "H18") 'Les cellules a copier sont stockées dans la variable Add
        With FichierS.Sheets("Copie")
            For i = 0 To UBound(Add) 'Je ne comprend pas Ubound
                .Range(Add(i)).Copy FichierD.Sheets("Colle").Cells(LigneD, ColD)
                ColD = ColD + 1
            Next i
        End With
    End Sub

Encore merci de nous faire partager vos connaissances.

Add = Array("B4", "D8", "F12", "H18") est une variable tableau qui contient les 4 adresses des valeurs à copier.

Les 4 éléments de Add ont un indice qui va de 0 à 3.

On obtient donc Add(0)="B4", Add(1)="D8", etc.

UBound renvoie l'indice le plus élevé disponible, à savoir 3.

ColD est une variable qui représente le numéro de colonne où doit être placée la données copiée.

Elle est initialisée à 1.

Dans la boucle :

For i = 0 To UBound(Add)

Next i

La valeur des cellules correspondant aux adresses données par Add est copiée dans la feuille destination à la LigneD (première ligne vide) et à la colonne ColD.

Pour décaler de 1 colonne à chaque incrémentation, il suffit d'incrémenter ColD avec l'instruction

ColD = ColD + 1.

A+

Bonjour a tous,

Merci beaucoup pour ces explication. C'est exactement ce que je voulais.

A bientôt et bonne journée a tous

Résolu.

Bonjour,

J'ai marqué résolu mais j'ai une dernière question.

Dans le cas ou il y aurais des formules dans les cellules que dois je modifier dans le code pour copier les valeur et pas les formules ?

En vous remerciant

Bonjour,

Il suffit de remplacer

.Range(Add(i)).Copy FichierD.Sheets("Colle").Cells(LigneD, ColD)

par

FichierD.Sheets("Colle").Cells(LigneD, ColD) = .Range(Add(i))

A+

Merci beaucoup c'est dont j'avais besoin.

Bonne soirée a tous