Copier coller entre classeur

Bonjour à tous,

J'essaie de réaliser la chose suivante :

Dans tous les classeurs du dossiers (à l'exception de celui nommée "SYNT")

Je cherche à ajouter une feuille nommée "CONF"

Afin d'y coller un tableau à partir de cellules copiées dans un classeur ouvert

J'ai rédigé ce code mais ça ne marche pas, votre aide serait vraiment la bienvenue :

(La création des feuilles se fait bien mais pas moyen de faire le copier - coller)

Sub ouvrirfichiers()

Dim Fichier As String, Chemin As String
Dim Wb As Workbook
Dim X As Long

Windows("SOURCETAB.xls").Activate
Sheets("CONS").Activate
Range("A1:M16").Select
Selection.Copy
Chemin = "C:\FEVRIER 2018\"
Fichier = Dir(Chemin & "*.xls")
Do While Fichier <> "SYNT.xls"
    Set Wb = Workbooks.Open(Chemin & Fichier)
    Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "CONSO"
    With Sheets("CONSO")
        Range("A1").Select
        .Paste
        Cells.Select
            Selection.Replace What:="='C:\[SOURCETAB.xls]Feuil", Replacement:="=Feuil", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False
Application.AlertBeforeOverwriting = False
Wb.Save
Wb.Close

Set Wb = Nothing
End With

Fichier = Dir
Loop
End Sub

bonjour,

si j'ai bien compris ce que tu cherches à faire

Sub ouvrirfichiers()

    Dim Fichier As String, Chemin As String
    Dim Wb As Workbook
    Dim X As Long

    Set rtc = Workbooks("SOURCETAB.xls").Sheets("cons").Range("A1:M16")
    Chemin = "C:\FEVRIER 2018\"
    Fichier = Dir(Chemin & "*.xls")
    Do While Fichier <> ""
        If Fichier <> "SYNT.xls" Then
            Set Wb = Workbooks.Open(Chemin & Fichier)
            Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "CONSO"
            With Sheets("CONSO")
                rtc.Copy .Range("A1")
                .Cells.Replace What:="='C:\[SOURCETAB.xls]Feuil", Replacement:="=Feuil", _
                               LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
                               False, ReplaceFormat:=False
                Application.AlertBeforeOverwriting = False
                Wb.Save
                Wb.Close
            End If
            Set Wb = Nothing
        End With
        Fichier = Dir
    Loop
End Sub

Bonjour,

Merci pour votre aide,

la macro bloque sur la ligne

Set Wb = Workbooks.Open(Chemin & Fichier)

Avec erreur : "La méthode Open de l'objet workbooks a échouée

Une idée ?

bonjour,

que contient Fichier au moment du message d'erreur ?

Le code fonctionne, un espace en trop avait provoqué l'erreur, c'est donc résolu, merci beaucoup et bon après-midi

Rechercher des sujets similaires à "copier coller entre classeur"