XL 2013 Copier coller sur 3 onglets

maval

XLDnaute Barbatruc
Bonjour
je recherche un code VBA pour copier la colonne B6;B60 vers onglet 2 & 3 en B6;B60
Je joint mon fichier
Je vous remercie d'avance
 

Pièces jointes

  • Classeur copier.xlsm
    13.9 KB · Affichages: 10

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Maval,
Un essai en PJ avec :
VB:
Sub Copie()
    Dim DL%
    Application.ScreenUpdating = False
    DL = Range("B65500").End(xlUp).Row 'Dernière ligne occupée
    Sheets("Table").Range("B6:B" & DL) = Range("B6:B" & DL).Value
    Sheets("Score").Range("B6:B" & DL) = Range("B6:B" & DL).Value
End Sub
qui copie que la liste utile.
si vous tenez à l'index 60 alors :
Code:
Sub Copie2()
    Dim DL%
    Application.ScreenUpdating = False
    Sheets("Table").Range("B6:B60") = Range("B6:B60").Value
    Sheets("Score").Range("B6:B60") = Range("B6:B60").Value
End Sub
 

Pièces jointes

  • Classeur copier.xlsm
    20.2 KB · Affichages: 4

Eric C

XLDnaute Barbatruc
Bonjour le forum
Bonjour maval, Sylvanu, Staple1600

@Staple1600 : La méthode ".FillAcrossSheets" doit être récente (365 ??) car bien que la plage de données soit sélectionnée, les copies sont vides sur les autres feuilles ??? Je possède XL2010, l'un explique peut être l'autre.
Bonne journée à toutes & à tous
@+ Eric c
 

Efgé

XLDnaute Barbatruc
Bonjour à tous
Pas de copie avec FillAcrossSheets dans la version
1646142041668.png

Ca commence à être fatigant c'est différences de réactions suivant les versions, vous ne trouvez pas ?
Cordialement
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil,

J'ai testé la macro sur Excel 2019 au boulot. (hier quand j'ai posté, j'étais sur Excel 2013)
Elle fonctionne.

Voir ci-dessous pour tester plus avant
NB: L'avantage c'est les trois options disponibles :
xlFillWithAll (par défaut), ou xlFillWithContents et enfin xlFillWithFormats
Code:
Sub MiseAjourRegistre_B()
Dim arrWSN
arrWSN = Array("Feuil1", "Feuil2", "Feuil3")
Worksheets(arrWSN).FillAcrossSheets Worksheets("Feuil1").Range("B5:B60")
End Sub
Sub MiseAjourRegistre_C()
Dim arrWSN
arrWSN = Array("Feuil1", "Feuil2", "Feuil3")
Worksheets(arrWSN).FillAcrossSheets Worksheets("Feuil1").Range("B5:B60"), xlFillWithContents
End Sub
Sub MiseAjourRegistre_D()
Dim arrWSN
arrWSN = Array("Feuil1", "Feuil2", "Feuil3")
Worksheets(arrWSN).FillAcrossSheets Worksheets("Feuil1").Range("B5:B60"), xlFillWithFormats
End Sub
Sub Pour_Tester()
Feuil1.Columns(2).Delete
Feuil2.Columns(2).Delete
Feuil3.Columns(2).Delete
With Feuil1.[B5]
    .Value = "ITEMS"
    .Font.Bold = -1
    .Interior.Color = RGB(197, 197, 197)
End With
Feuil1.Cells(6, 2).Resize(Application.RandBetween(5, 60)) = "=RoW()*PI()"
Feuil1.UsedRange = Feuil1.UsedRange.Value
Feuil1.UsedRange.Borders.Value = 1
End Sub

NB: A vérifier mais je pense que FillAcrossSheets était déjà disponible sous Excel 97
 

Discussions similaires

Réponses
7
Affichages
253
Réponses
4
Affichages
154
  • Résolu(e)
Microsoft 365 Copier par mois
Réponses
23
Affichages
507
Réponses
12
Affichages
326

Statistiques des forums

Discussions
312 815
Messages
2 092 326
Membres
105 366
dernier inscrit
beru19781978