Copier colonne et coller sur plusieurs feuilles

[Gregcherche]

Bonjour,

Pour mon travail 🙄, j'ai fais un classeur composé d'une feuille "type" que je suis amené à modifier, et de plusieurs autres feuilles (numérotés de 1 à 50) de composition identique à ma feuille type.

Je souhaiterais simplement faire une macro pour copier une colonne de ma feuille "type" et la coller sur l'ensemble de mes feuilles "1" à "50".

Merci pour votre considération,

 

[JNP]

Re : Copier colonne et coller sur plusieurs feuilles

Bonjour GregCherche, le forum 🙂,
Une première piste de travail:
Lance l'enregistreur de macro et enregistre la manipulation pour la feuille 1. Puis après avoir nettoyé le code, fait une boucle du type

Dim I as Integer
For I = 1 to 50
' là ton code nettoyé où tu remplaces les références à ta feuille 1
' par des références où I va permettre de faire toutes les feuilles de 1 à 50
Next I

Si tu n'y arrives pas, colle le code obtenu par l'enregistreur qui nous permettra de t'aiguiller.
Bonne journée 😎

 

[tototiti2008]

Re : Copier colonne et coller sur plusieurs feuilles

Bonjour Gregcherche, Bonjour JNP,

une proposition qui copie la colonne I de la feuille Type en colonne I des feuilles nommées de 1 à 50 :

 Dim ListeFeuille() As String, i as long
    ReDim ListeFeuille(1 To 1)
    For i = 1 To 50
        ReDim Preserve ListeFeuille(1 To i)
        ListeFeuille(i) = i
    Next i
    Sheets("Type").Columns("I:I").Copy
    Sheets(ListeFeuille).Select
    Columns("I:I").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Type").Select

 

[Gregcherche]

Re : Copier colonne et coller sur plusieurs feuilles

Je vous remercie pour ce code presque parfait 😉

Le "presque parfait" est de ma faute, j'ai oublié de préciser qu'il manque certaines feuilles parmi mes "1" à "50".
Par conséquent, une erreur se produit sur la ligne :

    Sheets(ListeFeuille).Select

Auriez-vous la solution à ça?

 

[JNP]

Re : Copier colonne et coller sur plusieurs feuilles

Re le forum 🙂,
Un code à manier avec une vigilance particulière est la gestion d'erreur. Tu peux ignorer l'erreur en mettant "On Error Resume Next" (qui va annuler la gestion des erreurs) devant le code qui coince, et surtout ne pas oublier juste après de mettre un "On Error Goto 0" (qui va rétablir la gestion des erreurs). Mais attention, dès que tu débraye la gestion d'erreur, tu ne peux plus être sûr de rien...
Bon courage 😎

 

[tototiti2008]

Re : Copier colonne et coller sur plusieurs feuilles

Re,

Code modifié à tester :

Function ExisteFeuille(ByVal NomFeuil As String) As Boolean
    ExisteFeuille = False
    On Error GoTo err1
    A = ThisWorkbook.Worksheets(NomFeuil).Range("A1").Value
    ExisteFeuille = True
    On Error GoTo 0
err1:
End Function
Sub CopieColonne()
 Dim ListeFeuille() As String, i As Long
    ReDim ListeFeuille(1 To 1)
    For i = 1 To 50
        If ExisteFeuille(CStr(i)) Then
            If i > 1 Then ReDim Preserve ListeFeuille(1 To UBound(ListeFeuille) + 1)
            ListeFeuille(UBound(ListeFeuille)) = i
        End If
    Next i
    Sheets("Type").Columns("I:I").Copy
    Sheets(ListeFeuille).Select
    Columns("I:I").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Type").Select
End Sub

 

[Gregcherche]

Re : Copier colonne et coller sur plusieurs feuilles

Slt,

Depuis que vous m'aviez aidé à faire cette macro, mon fichier à évolué...
J'ai déplacé certaines fiches dans un autre classeur, j'en ai crée d'autres, etc

Enfin bref, je souhaite de nouveau faire ce "copier coller" mais sur les fiches 208 à 5 : j'ai donc essayé de modifier le code ci-dessous, mais celui-ci bloque de nouveau à la ligne :

 Sheets(ListeFeuille).Select

NOUVEAU CODE :

 Function ExisteFeuille(ByVal NomFeuil As String) As Boolean
    ExisteFeuille = False
    On Error GoTo err1
    A = ThisWorkbook.Worksheets(NomFeuil).Range("A1").Value
    ExisteFeuille = True
    On Error GoTo 0
err1:
End Function
Sub CopieColonne()
 Dim ListeFeuille() As String, i As Long
    ReDim ListeFeuille(1 To 1)
    For i = 208 To 39
        If ExisteFeuille(CStr(i)) Then
            If i > 1 Then ReDim Preserve ListeFeuille(1 To UBound(ListeFeuille) + 1)
            ListeFeuille(UBound(ListeFeuille)) = i
        End If
    Next i
    Sheets("Type").Columns("D:G").Copy
    Sheets(ListeFeuille).Select
    Columns("D:G").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Type").Select
End Sub '