Sujet Précédent Sujet Suivant

Macro à modifier

Résolu/Fermé
Utilisateur anonyme - 14 déc. 2015 à 19:51
 Utilisateur anonyme - 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
A voir également:

2 réponses

Réponse 1 / 2
ccm81 Messages postés 10853 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 24 avril 2024 2 404
14 déc. 2015 à 20:07
Bonjour

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

Cdlmnt
0
Utilisateur anonyme
14 déc. 2015 à 20:23
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
Réponse 2 / 2
ccm81 Messages postés 10853 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 24 avril 2024 2 404
Modifié par ccm81 le 14/12/2015 à 20:30
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
Utilisateur anonyme
14 déc. 2015 à 22:04
Merci
0