Copier coller entre classeur Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
P
PG59180
Membre habitué
Membre habitué
Messages : 106
Inscrit le : 21 janvier 2013
Version d'Excel : 2003

Message par PG59180 » 12 juillet 2018, 14:24

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
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 8'433
Appréciations reçues : 280
Inscrit le : 16 juin 2013
Version d'Excel : 2013 UK Windows 10

Message par h2so4 » 12 juillet 2018, 14:43

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
P
PG59180
Membre habitué
Membre habitué
Messages : 106
Inscrit le : 21 janvier 2013
Version d'Excel : 2003

Message par PG59180 » 12 juillet 2018, 14:53

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 ?
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 8'433
Appréciations reçues : 280
Inscrit le : 16 juin 2013
Version d'Excel : 2013 UK Windows 10

Message par h2so4 » 12 juillet 2018, 14:59

bonjour,

que contient Fichier au moment du message d'erreur ?
P
PG59180
Membre habitué
Membre habitué
Messages : 106
Inscrit le : 21 janvier 2013
Version d'Excel : 2003

Message par PG59180 » 12 juillet 2018, 15:23

Le code fonctionne, un espace en trop avait provoqué l'erreur, c'est donc résolu, merci beaucoup et bon après-midi
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message