Macro à modifier [Résolu/Fermé]

Messages postés
159
Date d'inscription
mercredi 26 janvier 2011
Statut
Membre
Dernière intervention
31 août 2019
- - Dernière réponse : delta70
Messages postés
159
Date d'inscription
mercredi 26 janvier 2011
Statut
Membre
Dernière intervention
31 août 2019
- 14 déc. 2015 à 22:04
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
Afficher la suite 

2 réponses

Messages postés
9116
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
16 septembre 2019
1627
0
Merci
Bonjour

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

Cdlmnt
delta70
Messages postés
159
Date d'inscription
mercredi 26 janvier 2011
Statut
Membre
Dernière intervention
31 août 2019
-
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é
Messages postés
9116
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
16 septembre 2019
1627
0
Merci
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
delta70
Messages postés
159
Date d'inscription
mercredi 26 janvier 2011
Statut
Membre
Dernière intervention
31 août 2019
-
Merci