Macro à modifier [Résolu/Fermé]

Signaler
Messages postés
182
Date d'inscription
mercredi 26 janvier 2011
Statut
Membre
Dernière intervention
8 juillet 2020
-
Messages postés
182
Date d'inscription
mercredi 26 janvier 2011
Statut
Membre
Dernière intervention
8 juillet 2020
-
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

Messages postés
9572
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
28 septembre 2020
1 910
Bonjour

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

Cdlmnt
Messages postés
182
Date d'inscription
mercredi 26 janvier 2011
Statut
Membre
Dernière intervention
8 juillet 2020
3
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
9572
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
28 septembre 2020
1 910
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
Messages postés
182
Date d'inscription
mercredi 26 janvier 2011
Statut
Membre
Dernière intervention
8 juillet 2020
3
Merci