Macro à modifier

Résolu
Utilisateur anonyme -  
 Utilisateur anonyme -
Bonsoir,
J’utilise le code ci-dessous, que j’ai trouvé dans un forum pour faire copier et coller une plage de cellules identique à la plage source sur une la même feuille ou une autre.
Mon problème c’est que j’ai 28 feuilles dans mon classeur (24 feuilles sont nommées a1, a2, a3,…a24) et je veux copier et coller la même plage de la première feuille « a1 » sur les 23 feuilles qui reste avec 4 feuilles exclues
Comment faire modifier ce code pour résoudre le problème ?
Par avance merci du temps que vous prendrez afin de m'aider.
Cordialement.

Private Sub CommandButton2_Click()
Dim SHsource As Worksheet, SHcible As Worksheet, x As Integer
Dim PlageSource As Range, CelluleCible As Range, i As Integer
Set SHsource = ThisWorkbook.Sheets("a1") '<-- classeur source
Set SHcible = Workbooks("Rattrapage").Sheets("a3") '<-- classeur cible
Set PlageSource = SHsource.Range("test") '<-- plage de cellules à copier
Set CelluleCible = SHcible.Range("A3") '<-- destination (à partir de F11)
PlageSource.Copy CelluleCible '<-- copie de la plage
'adaptation hauteur des lignes
x = 0
For i = CelluleCible.Row To CelluleCible.Row + PlageSource.Rows.Count
x = x + 1
SHcible.Cells(i, 1).RowHeight = PlageSource.Rows(x).RowHeight
Next
'adaptation largeur des colonnes
x = 0
For i = CelluleCible.Column To CelluleCible.Column + PlageSource.Columns.Count
x = x + 1
SHcible.Cells(1, i).ColumnWidth = PlageSource.Columns(x).ColumnWidth
Next
End Sub

2 réponses

  1. ccm81 Messages postés 11033 Statut Membre 2 434
     
    Bonjour

    Un petit exemple à adapter
    http://www.cjoint.com/c/ELotgF2exLH

    Cdlmnt
    0
    1. Utilisateur anonyme
       
      Merci infiniment à Toi ccm81, c'est exactement ce que je recherchai
      Je vais gagner un temps.

      Merci, merci
      Bonne fête de fin d’année
      Bonne soiré
      0
  2. ccm81 Messages postés 11033 Statut Membre 2 434
     
    De rien

    Un peu plus propre
    Private Sub CommandButton1_Click()
    Dim nuf As Long, nbf As Long, PlageSource As Range
    nbf = Sheets.Count
    Set PlageSource = Sheets(FS).Range("test")
    For nuf = 1 To nbf
    If Left(Sheets(nuf).Name, 1) = FB Then
    PlageSource.Copy Sheets(nuf).Range(CB)
    End If
    Next nuf
    End Sub

    Bonnes fêtes à toi et à toute ta famille

    Cdlmnt
    0
    1. Utilisateur anonyme
       
      Merci
      0