Copier Coller d'un classeur à l'autre

Bonjour à toutes et à tous.

Avec l'aide d'un membre d'un autre forum j'ai réussi à mettre en place un début de code pour réaliser la copie de certaine cellules d'un classeur (base de donnée) vers un autre classeur (Fiche client)

L'idée est que chaque ligne de la base de donnée correspond à un client et donc on rempli le classeur fiche client avec les infos propres à chaque client.

le code en question le voila

Sub TransfertClient()

Dim Lig As Integer
Dim Wks As Worksheet
Dim Chemin As String
Dim Wbk1 As Workbook, Wbk2 As Workbook

    Chemin = ThisWorkbook.Path & "\"
    Set Wks = Sheets(1)
    Set Wbk1 = Workbooks.Open(Filename:="C:\Documents and Settings\Admin\Bureau\XLS\FICHECLIENTV2.xls")
    Set Wbk2 = ThisWorkbook
    Set Wbk1 = ActiveWorkbook
    'Le fichier CSV doit déjà être présent.

    For Lig = 2 To Cells(Rows.Count, "C").End(xlUp).Row

        With ActiveWorkbook
            Wks.Cells(Lig, 1).Copy .Sheets(1).Cells(6, 4)
            Wks.Cells(Lig, 2).Copy .Sheets(1).Cells(4, 4)
            Wks.Cells(Lig, 3).Copy .Sheets(1).Cells(2, 4)
            Wks.Cells(Lig, 4).Copy .Sheets(1).Cells(10, 2)

            .SaveAs Chemin & Replace([D2] & " - " & [B10].Value, ".", " ")

        End With
    Next Lig
End Sub

ça tourne plutot bien le seul souci c'est à la fin il ne s'arrete pas au dernier client.

et autre probleme je n'arrive pas a faire

Set Wbk1 = Workbooks.Open(Filename:="C:\Documents and Settings\Admin\Bureau\XLS\FICHECLIENTV2.xls")

par set Wbk1 = Chemin & FICHECLIENTV2.xls ou quelque chose comme ça je maitrise pas trop

Je vous joints les deux document : la base de donnée ou est situé

Je vous remercie d'avance pour votre aide.

Benj

Bonjour

Essaies cette macro

Option Explicit

Sub TransfertClient()
Dim Lig As Long
Dim Wks As Worksheet
Dim Chemin As String

    Application.ScreenUpdating = False
    Chemin = ThisWorkbook.Path & "\"
    Set Wks = Sheets(1)
    'Le fichier CSV doit déjà être présent.

    'With Workbooks.Open(Filename:="C:\Documents and Settings\Admin\Bureau\XLS\FICHECLIENTV2.xls")

    ' Pour mes tests
    With Workbooks.Open(Chemin & "FICHECLIENTV2.xls")
      For Lig = 2 To Wks.Cells(Rows.Count, "C").End(xlUp).Row
        Wks.Cells(Lig, 1).Copy .Sheets(1).Cells(6, 4)
        Wks.Cells(Lig, 2).Copy .Sheets(1).Cells(4, 4)
        Wks.Cells(Lig, 3).Copy .Sheets(1).Cells(2, 4)
        Wks.Cells(Lig, 4).Copy .Sheets(1).Cells(10, 2)
        .SaveAs Chemin & Replace(.Sheets(1).Range("D2") & " - " & .Sheets(1).Range("B10").Value, ".", " ")
      Next Lig
      .Close savechanges:=False
    End With
End Sub

Bonjour,

Je ne peux pas ouvrir ton fichier RAR car je n'ai pas le bon programme.

Pour la deuxième question :

et autre probleme je n'arrive pas a faire

Set Wbk1 = Workbooks.Open(Filename:="C:\Documents and Settings\Admin\Bureau\XLS\FICHECLIENTV2.xls")

par set Wbk1 = Chemin & FICHECLIENTV2.xls

Il faut savoir à quoi correspond l'instruction THISWORKBOOK.PATH

Si tu n'est pas sûr mets ceci au démarrage de la macro --> MSGBOX THISWORKBOOK.PATH & "\"

Cela te donnera le répertoire exact et te permettra de bien définir la variable CHEMIN

A te relire

Dan a écrit :

Il faut savoir à quoi correspond l'instruction THISWORKBOOK.PATH

c'est le chemin d'accès a la base de donnée

Les deux fichiers sont dans le même dossier donc normalement ça devrait pas poser de problème

ça marche impec merci beaucoup.

Pour pousser un plus loin la réflexion la mise en forme du fichier destination est changé est ce qu'il y aurait une méthode pour éviter ça ?

Sinon utiliser l'quivalent du pinceau en VBA avec

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

ça alourdit un peu le code mais bon ça fonctionne

Bonjour

Pas teste mais cela doit fonctionner

Utilises l'affectation : Modifies cette partie

.Sheets(1).Cells(6, 4) = Wks.Cells(Lig, 1)
.Sheets(1).Cells(4, 4) = Wks.Cells(Lig, 2)
.Sheets(1).Cells(2, 4) = Wks.Cells(Lig, 3)
.Sheets(1).Cells(10, 2) = Wks.Cells(Lig, 4)

Merci c'est parfait

J'ai fini en modifiant une case qui était une date (merci l'enregistreur de macro)

Bonne fin d'après midi et à bientot