Copier avec liaison dans une autre feuille (compilation)
Fermé
Anafolia
-
6 déc. 2014 à 05:42
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 - 7 déc. 2014 à 13:19
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 - 7 déc. 2014 à 13:19
A voir également:
- Copier avec liaison dans une autre feuille (compilation)
- Copier une vidéo youtube - Guide
- Recherchev dans une autre feuille ✓ - Forum Excel
- Super copier - Télécharger - Gestion de fichiers
- Vba copier une feuille dans un autre classeur ✓ - Forum VB / VBA
- Supprimer une feuille word - Guide
1 réponse
ThauTheme
Messages postés
1442
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
29 juillet 2022
160
7 déc. 2014 à 13:19
7 déc. 2014 à 13:19
Bonjour Anafolia, bonjour le forum,
Essaie comme ça :
Essaie comme ça :
Sub Compiler()
Dim G As Object 'déclare la variable G (onglet Global 2015)
Dim O As Object 'déclare la variable O (Onglets)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim TEST As Boolean 'déclare la variable TEST
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set G = Sheets("Global 2015") 'définit l'onglet G
G.Range("A2:W" & Application.Rows.Count).ClearContents 'efface les anciennes données de l'onglet G
For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
'si l'onglet n'est pas "Global 2015" ou si la dernière ligne éditée de l'onglet est inférieure à 5, va à l'étiquette "suite"
If O.Name = G.Name Or O.Cells(Application.Rows.Count, 1).End(xlUp).Row < 5 Then GoTo suite
TC = O.Range("A1:W" & O.Cells(Application.Rows.Count, 1).End(xlUp).Row) 'définit le tableau de cellules TC
For I = 5 To UBound(TC, 1) 'boucle 2 : sur toutes les lignes du tableau TC (en partant de la cinquième)
For J = 1 To UBound(TC, 2) 'boucle 3 : sur toutes les colonnes du tableau TC
'si une cellule de la ligne n'est pas vide, définit la variable TEST, sort de la boucle 3
If TC(I, J) <> "" Then TEST = True: Exit For
Next J 'prochaine colonne de la boucle 3
If TEST = True Then 'condition : si test est [Vrai]
TEST = False 'réinitialise TEST à [Faux]
'définit la cellule de destination DEST
Set DEST = G.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
O.Cells(I, 1).Resize(1, 23).Copy DEST 'copie la ligne dans DEST
End If 'fin de la condition
Next I 'prochaine ligne de la boucle 2
suite: 'étiquette
Next O 'prochain onglet de la boucle 1
Application.ScreenUpdating = False 'affiche les rafraîchissement d'écran
End Sub