Discussion :

[isolf]

Bonjour à tous,

Je souhaiterais créer une macro pour copier/coller des données d'un classeur à un autre sous condition de la date du jour.
Le classeur 1 s'incrémente de plusieurs lignes tous les jours, et je souhaiterais récupérer uniquement les données du jour pour incrémenter le classeur 2, mais je ne sais vraiment pas par ou commencer

Je suis vraiment débutant et n'arrive pas à assimiler et transposer les codes proposés sur le forum.

Si quelqu'un peut me proposer une piste je me débrouillerai pour décortiquer tous ça!!

d'avance merci

[had4789]

Bonjour,

"Le classeur 1 s'incrémente de plusieurs lignes tous les jours".

Est-ce dans ces lignes se trouve la date du jours?

Est-ce que la date est importante.

Si la date n'est pas importante, est-ce que les donnés présentes dans les deux classeurs sont les mêmes et quelles sont organisées de la même manière?

[had4789]

Ce code copie les informations de la feuil1 vers la feuil3 puis dans la feuil3 supprimer les lignes pour lesquels la date ne correspond pas à celle indiquée en H2.

Il te faut maintenant spécifier le nom des classeurs via workbook et le tour est jouer.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Immo_TA()
Application.ScreenUpdating = False
Dim i As Integer
 
 Sheets("Feuil1").Range("A:E").Copy Destination:=Sheets("Feuil3").Range("A:E")
 
Sheets("Feuil3").Select
 
 
 
With ThisWorkbook.Sheets("Feuil3")
'Précisez le nom de votre feuille
            For i = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
'je travaille sur la colonne c
'Rows.count permet de retourner le nombre de ligne de la plage range
                        If .Range("E" & i).Value <> Sheets("Feuil1").Range("H2").Value Then
                        Rows(i).Delete
 
                        End If
            Next i
End With
 
End Sub

[isolf]

bonjour,

oui la date est présente dans chaque ligne.

Je me suis mal exprimé lors du premier post, dans l'exemple j'ai condensé les deux classeurs sur deux feuilles.

Les données sont formatées de la même façons dans les deux classeurs.

Je souhaiterais exporté dans la feuille2, uniquement les données incrémentées dans la feuille1 qui ne sont pas déjà présente dans la feuille2 en comparant avec la date.

merci

Je n'avais pas vu votre second post... j'essai votre code

Merci, cela fonctionne et surtout j'ai compris . Mais j'aimerais conserver les "anciennes" données de la feuille2.
Je pourrai copier les données dans une feuilles pour les isoler, puis les incrémenter dans mon classeur final mais je pense qu'il y a plus simple?

[Philippe Tulliez]

Bonjour,
Pour exporter des données d'une liste se trouvant sur une feuille vers une autre et ce sous conditions, rien de tel que le filtre avancé d'excel (manuellement ou par VBA). En VBA, cela prend un ligne de code maximum pour l'exportation.
A lire Les filtres avancés ou élaborés dans Excel

[had4789]

Je ne vois pas vraiment où tu veux en venir mais bon.

Avec mon code tu conserves les "anciennes" données de la feuille2 puisque la suppression se fait dans la feuille3.

Ce que tu dois faire c'est copier les valeurs de ta feuil3 dans ta feuil2.

Voici une piste

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Feuil3").Range("A1:D1").Copy Destination:=Sheets("Export").Range("A65000").End(xlUp)

[Philippe Tulliez]

Bonjour,
Une autre solution avec la méthode AdvancedFilter de l'objet Range (Filtres avancés d'excel)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub ExportationDataSuivantCritere()
 ' Déclaration des variables
 Const CriteriaLabel As String = "Date" ' Etiquette du critère
 Dim rngSource As Range, rngTarget As Range, rngCriteria As Range
 ' Attribution des références aux variables objets
 With ThisWorkbook
  Set rngSource = .Worksheets("Feuil1").Range("A1").CurrentRegion
  Set rngTarget = .Worksheets("Feuil3").Range("A1").CurrentRegion
 End With
 With rngSource: Set rngCriteria = .Offset(, .Columns.Count).Resize(2, 1): End With
 ' Réattribution des références aux objets
 '    Calcul la ligne qui suit la dernière ligne de rngTarget.
 '    Si dernière ligne = 1 garde cette valeur
 With rngTarget: Set rngTarget = .Offset(Abs((.Rows.Count <> 1) * .Rows.Count)).Resize(1, 1): End With
 ' Ecriture des critères (Date du jour)
 With rngCriteria: .Cells(1, 1) = CriteriaLabel: .Cells(2, 1) = Date: End With
 ' Exportation des données suivant critères
 rngSource.AdvancedFilter xlFilterCopy, rngCriteria, rngTarget
 ' Fin de procédure
 If rngTarget.Row > 1 Then Rows(rngTarget.Row).Delete ' Supprime la ligne des titres exportées
 rngCriteria.Clear ' Efface la zone des critères
 Set rngSource = Nothing: Set rngTarget = Nothing: Set rngCriteria = Nothing
End Sub