A voir également:
- Copier/coller des élts avec If et Boucles
- Dessin sms copier coller zizi ✓ - Forum Internet / Réseaux sociaux
- Coeur copier coller ✓ - Forum Internet / Réseaux sociaux
- Copier video youtube - Guide
- Super copier - Télécharger - Gestion de fichiers
- Zizi copier coller ✓ - Forum Internet / Réseaux sociaux
2 réponses
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
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
Patrice33740
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 763
2 nov. 2011 à 14:03
2 nov. 2011 à 14:03
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