Copier/coller des élts avec If et Boucles

Moonflash -  
 Moonflash -
Bonjour,

J'ai un classeur avec beaucoup de feuilles.
Je cherche à tester les données sur chacune des feuilles.
Si la date inscrite ( en colonne L) est celle du jour ou à venir. Alors, je copie certains éléments que je colle sur une feuille de référence. ( a tester sur chacune des feuilles)
Plusieurs lignes sont concernées
Plusieurs feuilles sont concernées

Ma feuille de référence est celle nommée Tableau de bord.
Quasiment toutes les autres feuilles portent des noms totalement différents de plus de 2 lettres
Sur chaque feuille avec un nombre de lettres > 2 (Ne pas faire les feuilles qui portent moins de 2 lettres), la zone de données qui m'intéresse A16:L80

Sur feuille x
Si la date en L16 est > ou = à la date du jour
alors
copier A3 et copier A16 et copier G16 et copier H16 et copier L16
Sélectionner la feuille "tableau de bord "
sur la première ligne de vide
Coller en colonne A les données copiées de A3 feuille x
Coller en colonne B les données copiées de A16 feuille x
Coller en colonne C les données copiées de G16 feuille x
Coller en colonne D les données copiées de H16 feuille x
Coller en colonne E les données copiées de L16 feuille x
Retourner sur feuille x
faire la ligne 17 et recommencer le si
ainsi de suite jusqu'à ce qu'il n'y ai plus rien d'inscrit sur la ligne (test sur la 1ère cellule de la ligne)
Passer à la feuille x+1
et recommencer le test Si sur chacune des lignes
jusqu'à la dernière feuille du classeur

J'ai établi qques lignes de codes mais au final j'ai le message d'erreur exécution 1004 :-(

Somebody please help me...

A voir également:

2 réponses

Moonflash
 
Mes lignes de codes actuelles. Mm si il manque des infos.

Sub datederappel()
Dim Li As Variant
Dim lix As Variant ' ligne variable
Dim Fe As Variant
Dim fex As Variant ' feuille variable

Sheets("Tableau de bord").Activate
Application.ScreenUpdating = False
For Each Fe In ActiveWorkbook.Sheets 'Pour chaque feuille du classeur
For fex = 2 To ActiveWorkbook.Sheets.Count
For Each Li In ActiveWorkbook.Sheets 'Pour chaque ligne de la zone concernée
For lix = 16 To 80 'Pour les lignes de 16 à 80

'Copier les données nécessaires
Worksheets(fex).Activate
If (L, lix) >= Now Then
Worksheets(fex).Range("A3").Copy Sheets("Tableau de bord").Range("A")
Worksheets(fex).Range(A, lix).Copy Sheets("Tableau de bord").Range("B")
Worksheets(fex).Range(G, lix).Copy Sheets("Tableau de bord").Range("C")
Worksheets(fex).Range(H, lix).Copy Sheets("Tableau de bord").Range("D")
Worksheets(fex).Range(L, lix).Copy Sheets("Tableau de bord").Range("E")

Sheets("Tableau de bord").Activate
Selection.End(xlToRight).Offset(0, 1).Select 'sélection de la 1ère ligne de vide sur TDB
End If
Next
Next

Next
Next

End Sub
0
Patrice33740 Messages postés 8931 Date d'inscription   Statut Membre Dernière intervention   1 782
 
Essaies ce code :
Sub datederappel()
Dim wsh As Worksheet  'feuille concernée
Dim cel As Range      'cellule de destinatition dans TB
Dim n°F As Integer    'numéro de feuille variable
Dim n°L As Integer    'numéro de ligne variable

'Première cellule libre de TB
With ActiveWorkbook.Sheets("Tableau de bord")
  Set cel = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With
'Analyser les feuilles
For n°F = 2 To ActiveWorkbook.Worksheets.Count
  Set wsh = ActiveWorkbook.Worksheets(n°F)
  For n°L = 16 To 80 'Pour les lignes de 16 à 80
    If wsh.Cells(n°L, "L").Value >= Date Then
      'Copier les données nécessaires
      wsh.Range("A3").Copy Destination:=cel
      wsh.Cells(n°L, "A").Copy cel.Offset(, 1)
      wsh.Cells(n°L, "G").Copy cel.Offset(, 2)
      wsh.Cells(n°L, "H").Copy cel.Offset(, 3)
      wsh.Cells(n°L, "L").Copy cel.Offset(, 4)
      Set cel = cel.Offset(1)
    End If
  Next n°L
Next n°F

End Sub
0
Moonflash
 
yeahhhhhh!
Patrice, you rock!
Excellent, merci, Merci, MERCI
0