Copier-coller une feuille avec nom identique entre deux classeurs ouverts

thomas4530

XLDnaute Junior
Bonjour,

J'espère que ceci sera mon dernier appel à l'aide, je dois clôturer mon travail pour mercredi au plus tard.

Je vous résume la situation...

J'ai un fichier A qui contient plus d'une centaine de feuilles et une quasi infinité de données

J'ai un fichier B qui actuellement contient uniquement des feuilles dont le nom est identique à celle du fichier A.

Les deux fichiers A et B sont toujours ouverts.

Je souhaiterais dans le fichier B sur la feuille Nom_1 par exemple enregistrer une macro dont le message serait: dans le fichier A (ouvert) copie la feuille Nom_1 et colle les données dans cette feuille (fichier B feuille Nom_1).

J'avoue être totalement à la ramasse ! Pouvez-vous m'aider ?

Belle journée,

Thomas
 

VDAVID

XLDnaute Impliqué
Re : Copier-coller une feuille avec nom identique entre deux classeurs ouverts

Bonjour le forum, thomas4530,


Voici un exemple de code que tu peux insérer dans un module de ton classeur (Où tu veux copier les données)


Change le nom des classeurs sans oublier l'extension (le .xlsx ou .xlsm)

Je ne l'ai pas testé, donc n'hésite pas si tu as un soucis

Code:
Sub mtv()

    Dim Wk As Workbook, Wk1 As Workbook
    Dim Classeur1 As String, Classeur2 As String
    Dim Flag1 As Boolean, Flag2 As Boolean
    Dim i As Integer, h As Integer
    
    'Les libellés entre les guillemets sont à changer
    Classeur1 = "Nom du classeur où je vais copier mes données.xlsx"
    Classeur2 = "Nom du classeur où se trouvent les données à copier.xlsx"
    
    Flag1 = False
    Flag2 = False
    
    
    For i = 1 To Application.Windows.Count
        
        If Workbooks(i).Name = Classeur1 Then Flag1 = True
        If Workbooks(i).Name = Classeur2 Then Flag2 = True
        
    Next i
    
    If Flag1 = False Or Flag2 = False Then
        
        MsgBox "Un des classeurs n'a pas de nom valide", vbCritical, "Attention"
        Exit Sub
        
    End If
    
    Set Wk = Workbooks(Classeur1)
    Set Wk1 = Workbooks(Classeur2)
    
    For i = 1 To Wk.Sheets.Count
    
        For h = 1 To Wk1.Sheets.Count
            
            If Wk1.Sheets(h).Name = Wk.Sheets(i).Name Then
            
                Wk1.Sheets(h).Cells.Copy Destination:=Wk.Sheets(i).Cells
                GoTo Borne
                
            End If

        Next h
        Chaine = Chaine & " / " & Wk.Sheets(i).Name
        
Borne:
    Next i
    
    If Chaine <> "" Then
        
        MsgBox "Les feuilles suivantes n'ont pas été trouvées: " & vbNewLine & Chaine, vbExclamation, "Attention"
    
    End If
    
    
End Sub

Bonne journée !
 

thomas4530

XLDnaute Junior
Re : Copier-coller une feuille avec nom identique entre deux classeurs ouverts

Bonjour,

Merci pour vos réponses... mais j'avoue que je galère :(

Serait-il possible de connaitre le code à développer pour supprimer une même plage sur toutes les feuilles d'un classeur ?

Je m'énerve et je m'emmêle... je deviens fou :( :( :(

Thomas
 

VDAVID

XLDnaute Impliqué
Re : Copier-coller une feuille avec nom identique entre deux classeurs ouverts

Bonjour Bof !

Je ne comprends pas, ne voulais-tu pas copier coller des données entre deux classeurs? Tu galères avec le code que je t'ai envoyé?

Je peux te montrer un exemple de code pour supprimer des plages de données sur toutes les feuilles d'un classeur mais à l'aveugle ça risque de ne pas correspondre à tes attentes ...

Pourrais tu mettre en pièces jointes (Sans données confidentielles) les fichiers concernés; avec précisément ce que tu veux faire avec.

Cela nous aiderais à t'aider :)
 

thomas4530

XLDnaute Junior
Re : Copier-coller une feuille avec nom identique entre deux classeurs ouverts

Bonjour VDAVID,

Tout d'abord merci pour ton code. Mais je ne peux l'appliquer puisque les fichiers seront ouverts sur deux PC différents.

En pièce jointe, j'ai placé un fichier. Ce fichier est généré à partir d'un fichier de base qui contient énormément de données.

Le fichier en pièce jointe ne contient que deux feuilles mais en contiendra environ 100-150 par la suite.

Ce que je cherche à faire est de supprimer sur toutes les feuilles la plage:
- la plage "A42:BN2131"
- les colonne D, G, I, M, Q, T, W, Z, ... En fait toutes les colonnes où il y a "Prof." sur la première ligne.

Un tout grand merci,

Thomas
 

Pièces jointes

  • 2014-06-23 forum.xlsm
    109.9 KB · Affichages: 23
  • 2014-06-23 forum.xlsm
    109.9 KB · Affichages: 27
  • 2014-06-23 forum.xlsm
    109.9 KB · Affichages: 29
Dernière édition:

VDAVID

XLDnaute Impliqué
Re : Copier-coller une feuille avec nom identique entre deux classeurs ouverts

Re,

Voilà qui est mieux :)

Regarde en PJ, le code est dans le module "Module Nettoyage"
 

Pièces jointes

  • 2014-06-23%20forum(1).xlsm
    45.2 KB · Affichages: 40

thomas4530

XLDnaute Junior
Re : Copier-coller une feuille avec nom identique entre deux classeurs ouverts

VDAVID,

Je suis impressionné. Qu'est ce que j'aimerais pouvoir le faire...

J'ai juste un problème... mais un gros.

Le code que tu viens de développer s'applique à mon fichier original (il m'a donc effacé toutes mes données lorsque je l'ai lancé... merci les sauvegardes). Je souhaiterais qu'il s'applique au fichier professeur mais que je puisse le lancer depuis le fichier original...

Possible ?

Bien à toi,

Thomas
 

thomas4530

XLDnaute Junior
Re : Copier-coller une feuille avec nom identique entre deux classeurs ouverts

Je pense avoir trouvé...

Option Explicit
Option Base 1
Option Compare Text

Sub professeur()
Call Module1.macro_1("Herremans")
Call Module1.macro_1("Lebichot")
End Sub

Sub Herremans()
Call Module1.macro_1("Herremans")
End Sub

Sub Lebichot()
Call Module1.macro_1("Lebichot")
End Sub

Sub locaux()
Call Module2.macro_2("J_109")
End Sub

Sub copie_fichier_prof()
ThisWorkbook.SaveCopyAs "C:\Users\User\Documents\Jonfosse\Horaires\professeurs.xls"
Workbooks.Open "C:\Users\User\Documents\Jonfosse\Horaires\professeurs.xls"
Workbooks("professeurs.xls").Activate
Application.DisplayAlerts = False
Sheets(Array("Gestion", "J_109", "Données")).Delete
Dim i As Integer, h As Integer
Dim maPlage As Range
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
With Sheets(i)
Set maPlage = Sheets(i).Range("A42:BN2131")
maPlage.ClearContents
maPlage.ClearFormats
For h = 1 To .Cells(1, 287).End(xlToLeft).Column
If .Cells(1, h).Value Like "*Prof*" Then .Columns(h).Delete
Next h
End With
Next i
Application.ScreenUpdating = True
End Sub

Seul petit problème, lorsque je veux relancer le tout, il m'indique: erreur d"finie par l'application ou par l'objet...
 

VDAVID

XLDnaute Impliqué
Re : Copier-coller une feuille avec nom identique entre deux classeurs ouverts

Re,

Essaye plutôt comme ceci alors :

Code:
Option Explicit
Option Base 1
Option Compare Text


Dim i As Integer, h As Integer
Dim maPlage As Range
Dim Ws As Workbook


Sub Nettoyage()


    Application.ScreenUpdating = False
    
    Application.Dialogs(xlDialogFindFile).Show
    
    If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
    
    For i = 1 To Sheets.Count
        
        With Sheets(i)
        
            Set maPlage = Sheets(i).Range("A42:BN2131")
            
            maPlage.ClearContents
            maPlage.ClearFormats
            
            For h = 1 To .Cells(1, 287).End(xlToLeft).Column
                
                If .Cells(1, h).Value Like "*Prof*" Then .Columns(h).Delete
            
            Next h
            
        End With
        
    Next i
    
    Application.ScreenUpdating = True
    
End Sub

Tu sélectionne ton fichier, et ça te fais tourner la macro !
Sauvegarde bien avant de lancer ;)
 

thomas4530

XLDnaute Junior
Re : Copier-coller une feuille avec nom identique entre deux classeurs ouverts

Bonsoir VDavid et tous les autres,

Je mets la dernière main à mon travail.

Pourriez-vous me dire comme je peux intégrer le code ci-dessous (il est ici intégré dans une feuille unique du classeur) dans la macro suivante afin que le code se réalise sur toutes les feuilles du classeur "Professeur" ? Je bloque...

Voici le code
Sub tonight()
' Copie de la feuille de données
Sheets("Herremans").Range("A1:AT40").Copy Sheets("Herremans").Range("AV1:CO40")
Range("CN:CN, CL:CL, CJ:CJ, CH:CH, CE:CE, CC:CC, CA:CA, BY:BY, BV:BV, BT:BT, BR:BR, BP:BP, BM:BM, BK:BK, BI:BI, BG:BG, BD:BD, BB:BB, AZ:AZ, AX:AX").Delete
Range("AT:AT, AR:AR, AP:AP, AN:AN, AK:AK, AI:AI, AG:AG, AE:AE, AB:AB, Z:Z, X:X, V:V, S:S, Q:Q, O:O, M:M, J:J, H:H, F:F, D:D").Delete
End Sub


Voici la macro
Sub copie_fichier_prof()
ThisWorkbook.SaveCopyAs "C:\Users\User\Documents\Jonfosse\Horaires\professeurs.xls"

Workbooks.Open "C:\Users\User\Documents\Jonfosse\Horaires\professeurs.xls"
Workbooks("professeurs.xls").Activate

Application.DisplayAlerts = False
Sheets(Array("Gestion", "J_109", "Données")).Delete

Dim i As Integer, h As Integer
Dim maPlage As Range
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
With Sheets(i)
Set maPlage = Sheets(i).Range("A42:BN2131")
maPlage.ClearContents
maPlage.ClearFormats
For h = 1 To .Cells(1, 287).End(xlToLeft).Column
If .Cells(1, h).Value Like "*Prof*" Then .Columns(h).Delete
Next h
End With
Next i
Application.ScreenUpdating = True

Workbooks("professeurs.xls").Close True
End Sub


Déjà un tout grand merci et une toute belle soirée,

Thomas
 

VDAVID

XLDnaute Impliqué
Re : Copier-coller une feuille avec nom identique entre deux classeurs ouverts

Bonjour,

Si j'ai bien compris ce que tu veux faire, il faudrait l'insérer comme ceci:

Code:
Option Explicit
Option Base 1
Option Compare Text


Dim i As Integer, h As Integer
Dim maPlage As Range
Dim Ws As Workbook

Sub copie_fichier_prof()

ThisWorkbook.SaveCopyAs "C:\Users\User\Documents\Jonfosse\Horaires\profess eurs.xls"
'
Workbooks.Open "C:\Users\User\Documents\Jonfosse\Horaires\profess eurs.xls"
Workbooks("professeurs.xls").Activate

Application.DisplayAlerts = False
Sheets(Array("Gestion", "J_109", "Données")).Delete

Dim i As Integer, h As Integer
Dim maPlage As Range
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
With Sheets(i)
Set maPlage = Sheets(i).Range("A42:BN2131")
maPlage.ClearContents
maPlage.ClearFormats
For h = 1 To .Cells(1, 287).End(xlToLeft).Column
If .Cells(1, h).Value Like "*Prof*" Then .Columns(h).Delete
Next h


.Range("A1:AT40").Copy .Range("AV1:CO40")
.Range("CN:CN, CL:CL, CJ:CJ, CH:CH, CE:CE, CC:CC, CA:CA, BY:BY, BV:BV, BT:BT, BR:BR, BP:BP, BM:BM, BK:BK, BI:BI, BG:BG, BD:BD, BB:BB, AZ:AZ, AX:AX").Delete
.Range("AT:AT, AR:AR, AP:AP, AN:AN, AK:AK, AI:AI, AG:AG, AE:AE, AB:AB, Z:Z, X:X, V:V, S:S, Q:Q, O:O, M:M, J:J, H:H, F:F, D:D").Delete

End With
Next i
Application.ScreenUpdating = True

Workbooks("professeurs.xls").Close True
Application.DisplayAlerts = False

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 730
Messages
2 081 978
Membres
101 854
dernier inscrit
micmag26