Copier avec liaison dans une autre feuille (compilation)
Anafolia
-
ThauTheme Messages postés 1442 Date d'inscription Statut Membre Dernière intervention -
ThauTheme Messages postés 1442 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
J'ai un fichier avec plusieurs feuilles (une pour chaque moi de l'année) et un global qui cumul toutes les données.
Je suis vraiment débutante en VBA .....
Je voudrais que ma ligne A6;W6 (soit une plage de A6: A105; W6:W105) soit copier avec liaison dans une autre feuille au même endroit. Le hic c'est que j'ai plusieurs lignes dans chaque feuilles qui doivent s'ajouter une à la suite de l'autre dans le global et non toute la plage (je veux pas qu'il transfert des lignes vides que les lignes avec du contenu)
Je suis capable en VBA de faire le bouton et nommer la macro mais pour la programmation c'est là que ça se gâte
Alors voici ce que j'ai trouvé:
Sub Compiler()
Dim sh As Worksheet, aa, fin&, fin1&
Application.ScreenUpdating = 0
With Feuil13
fin1 = .Range("A" & Rows.Count).End(xlUp).Row
If fin1 < 5 Then fin1 = 5
.Range(.Cells(5, 1), .Cells(fin1, 26)).ClearContents
End With
For Each sh In Worksheets
If sh.Name <> "Global 2015" Then
fin = sh.Range("A" & Rows.Count).End(xlUp).Row
If fin < 5 Then GoTo 1
sh.Range("A5:W" & fin).Copy Feuil13.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
1 Next sh
End Sub
Le problème c'est qu'il copie toute la plage et les ajoutes un à la suite de l'autre avec les ligne blanche...on dirait une capture d'écran une à la suite de l'autre :S
Est-ce que quelqu'un pourrait m'aider svp
Merci :)
J'ai un fichier avec plusieurs feuilles (une pour chaque moi de l'année) et un global qui cumul toutes les données.
Je suis vraiment débutante en VBA .....
Je voudrais que ma ligne A6;W6 (soit une plage de A6: A105; W6:W105) soit copier avec liaison dans une autre feuille au même endroit. Le hic c'est que j'ai plusieurs lignes dans chaque feuilles qui doivent s'ajouter une à la suite de l'autre dans le global et non toute la plage (je veux pas qu'il transfert des lignes vides que les lignes avec du contenu)
Je suis capable en VBA de faire le bouton et nommer la macro mais pour la programmation c'est là que ça se gâte
Alors voici ce que j'ai trouvé:
Sub Compiler()
Dim sh As Worksheet, aa, fin&, fin1&
Application.ScreenUpdating = 0
With Feuil13
fin1 = .Range("A" & Rows.Count).End(xlUp).Row
If fin1 < 5 Then fin1 = 5
.Range(.Cells(5, 1), .Cells(fin1, 26)).ClearContents
End With
For Each sh In Worksheets
If sh.Name <> "Global 2015" Then
fin = sh.Range("A" & Rows.Count).End(xlUp).Row
If fin < 5 Then GoTo 1
sh.Range("A5:W" & fin).Copy Feuil13.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
1 Next sh
End Sub
Le problème c'est qu'il copie toute la plage et les ajoutes un à la suite de l'autre avec les ligne blanche...on dirait une capture d'écran une à la suite de l'autre :S
Est-ce que quelqu'un pourrait m'aider svp
Merci :)
A voir également:
- Copier avec liaison dans une autre feuille (compilation)
- Comment copier une vidéo youtube - Guide
- Super copier - Télécharger - Gestion de fichiers
- Comment faire un livret avec des feuilles a4 - Guide
- Bruler une feuille de laurier - Guide
- Comment supprimer une feuille sur word - Guide
1 réponse
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
