XL 2016 Recopie automatique

[benoitdigi]

Bonjour à tous,

je souhaite pouvoir automatiser la recopie de lignes de données de l'ensemble des feuilles UT 1 ... vers l'onglet "Plan d'action" , de mon fichier "doc test macro"

Pour que la recopie soit réalisée, il faut qu'a minima l'une des cellules O / P / Q soit complété

J'ai une autre contrainte, j'ai d'autres feuilles dans le fichiers concerné et je ne souhaite pas de recopie du contenu présent sur ces feuilles

Merci à tous pour vos lumières !

Benoit

 

[dg62]

Bonjour Benoitdigi

Pour te guider il faudrait un petit fichier test et une description claire et précise du problème.

 

[benoitdigi]

Bonjour à tous ,


Je souhaite recopier automatiquement dans l'onglet "Plan d'action" les lignes des UT 1 / 2.1 / 2.2 / 3 / 4, la recopie des lignes doit se faire uniquement si les lignes contiennent du texte dans une des colonnes J, K , L ( peu importe la ou les colonnes complétées, si au moins une des cellules des colonnes J K L est complété la recopie doit se faire)

Merci

 

[benoitdigi]

Re,

j'ai commencé une macro , mais ça ne fonctionne pas

Sub Transfert()

Dim Ws As Worksheet, Wd As Worksheet, A5%, j%, k%, l% 'Déclaration des variables
Application.ScreenUpdating = False 'Désactive le rafraissement Ecran
Range("A2:J65000").ClearContents 'nettoie la feuille Recap
j = 2
Set Wd = Sheets("Plan d'action")
For Each Ws In Worksheets 'Boucle sur les onglets
If Ws.Name <> "Plan d'action" And Ws.Name <> "UT 1" And Ws.Name <> "UT 2.1" And Ws.Name <> "C" Then 'sauf l'onglet de Plan d'action, UT 1 , UT 2.1,
Sheets(Ws.Name).Activate 'Active l'onglet
Set Ws = Sheets(Ws.Name)
A5 = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
For j = Not Empty To J5 'boucle sur les lignes
If Cells(j, 11) <> "" Then 'si la cellue colonne "j" n'est pas vide
Ws.Range(Cells(j, 1), Cells(j, 8)).Copy Wd.Cells(j, 1) 'copie vers la feuille plan d'action
Ws.Range(Cells(j, 13), Cells(j, 13)).Copy Wd.Cells(j, 9) 'copie vers la feuille plan d'action
j = j + 1 'ajoute 1 au compteur de ligne feuille plan d'action
End If
Next j
End If
Next Ws
Sheets("Plan d'action").Activate
Range("A5").Select
Application.ScreenUpdating = True

End Sub