Archivage conditionnel vers un nouveau classeur

Bonjour,

Je me penche sur un outil VBA permettant d'archiver les données d'un fichier Excel qui gère la location d'engins.

Le constat : A la fin de l'année le fichier Excel devient trop lourd : plus de 2000 lignes et environ 380 colonnes.

L'idée est d'archiver ces lignes en fonction de la valeur d'une colonne : Date de fin.

Ainsi nous pourrions exporter dans un nouveau classeur ce tableau afin de garder toutes les données mais de les séparer en plusieurs fichier (en fonction de la date de fin de location) afin d'alléger la taille.

Ex : le fichier 2019 LOCATION transfèrera ces donnés aux quatre fichiers suivants : 2019 LOCATION T1 (de janvier à mars), 2019 LOCATION T2(d'avril à juin), 2019 LOCATION T3(de juillet à septembre), 2019 LOCATION T4(d'octobre à décembre).

Le hic, c'est que nous avons un autre fichier qui lui, doit exploiter les données de tous les classeurs afin de faire un récapitulatif des couts des locations.

La première question est la suivante : VBA me permet-il de répondre à mes besoins?

La seconde : Vers quels outils VBA dois-je m'orienter?

Merci d'avance pour vos lumières.

Je peux aussi me tromper de stratégie en voulant générer 4 fichiers pour aller celui d'origine, je suis ouvert à toute suggestion

bonjour

il est normal d'avoir des milliers de lignes, mais pas d'avoir plus de colonnes

à quoi servent les colonnes ?

à te relire

amitiés et bonne année

En fait les colonnes vont de A à F, il s'agit du bandeau principale du tableau. Ensuite il y a le bandeau secondaire qui est juxtaposé au principal. Dans celui ci il y a un pseudo calendrier ou une colonne représente un jour calendaire. Lorsqu'un "1" est mis dans une de ces colonnes, la colonne dans le bandeau principale qui compte le nombre de jour de location s'incrémente de 1, affectant ainsi le prix de la location qui est basé sur un cout journalier + transport A/R.

Alors j'ai avancé un peu, voilà le code que j'ai fait.

Mon problème :

1. Malgré les instructions que je mets dans le code, j'ai l'impression que certaines lignes saute (passent entre les mailles du filets).

2. Les opérations ne sont pas optimisés, le code mets longtemps à s'exécuter (après c'est normal je pense vu qu'il a 2000 lignes a traiter, dans le futur l'archivage pour se faire régulièrement car le programme ne considère pas les lignes sans date de fin de location et le nombre de lignes a traiter sera donc moindre).

Je met mon code ci-dessous :

Sub Transfert()

'--DECLARATIONS-----------------------------------------'

Dim WbT1 As Workbook 'Déclarations des différents classeurs

Dim WbT2 As Workbook

Dim WbT3 As Workbook

Dim WbT4 As Workbook

Dim WbS As Workbook

Dim OS As Worksheet 'Déclarations des onglets de chaque classeur

Dim OD1 As Worksheet

Dim OD2 As Worksheet

Dim OD3 As Worksheet

Dim OD4 As Worksheet

Dim DEST As Range 'destination du copier coller

Dim DL As Long 'definition de la dernière ligne

Dim CD As Long 'colonne date de fin

Dim D1 As Date 'date limite pour le 1er trimestre

Dim D2 As Date 'date limite pour le second trimestre

Dim D3 As Date 'date limite pour le 3eme trimestre

Dim D4 As Date 'date limite pour le dernier trimestre

Dim Chemin As String 'chemin du dossier ou se trouve les fichiers excels

'--INITIALISATION---------------------------------------'

Chemin = ThisWorkbook.Path + "\"

Set WbS = ThisWorkbook 'définit le classeur source'

Set WbT1 = Workbooks.Open(Chemin + "2018 LOCATION T1.xls") 'définit le classeur 1 trimestre'

Set WbT2 = Workbooks.Open(Chemin + "2018 LOCATION T2.xls") 'définit le classeur 2 trimestre'

Set WbT3 = Workbooks.Open(Chemin + "2018 LOCATION T3.xls") 'définit le classeur 3 trimestre'

Set WbT4 = Workbooks.Open(Chemin + "2018 LOCATION T4.xls") 'définit le classeur 4 trimestre'

Set OS = WbS.Worksheets("suivie")

Set OD1 = WbT1.Worksheets("archive")

Set OD2 = WbT2.Worksheets("archive")

Set OD3 = WbT3.Worksheets("archive")

Set OD4 = WbT4.Worksheets("archive")

CD = 20 'Position de la colonne ou se trouve les dates de fin de location

DL = OS.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet OS du classeur WbS

D1 = CDate("01/04/2018")

D2 = CDate("01/07/2018")

D3 = CDate("01/10/2018")

D4 = CDate("31/12/2018")

'--CODE-------------------------------------------------'

For i = 6 To DL

If (OS.Cells(i, CD).Value < D1 And OS.Cells(i, CD).Value > 0) Then

'copie la ligne et on la déplace dans T1, puis on la supprime dans le fichier d'origine

Set DEST = OD1.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0) 'on parametre la destination

OS.Cells(i, "B").Resize(1, 21).Copy 'On copie la ligne

DEST.PasteSpecial xlPasteValues 'On fait un collage spécial des valeurs

OS.Cells(i, "B").EntireRow.Delete 'On supprime la ligne

' j1 = j1 + 1

Else:

If (OS.Cells(i, CD).Value >= D1 And OS.Cells(i, CD).Value < D2) Then

'copie la ligne et on la déplace dans T2, puis on la supprime dans le fichier d'origine

Set DEST = OD2.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)

OS.Cells(i, "B").Resize(1, 21).Copy

DEST.PasteSpecial xlPasteValues

OS.Cells(i, "B").EntireRow.Delete

'j2 = j2 + 1

Else:

If (OS.Cells(i, CD).Value < D3 And OS.Cells(i, CD).Value >= D2) Then

'copie la ligne et on la déplace dans T3, puis on la supprime dans le fichier d'origine

Set DEST = OD3.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)

OS.Cells(i, "B").Resize(1, 21).Copy

DEST.PasteSpecial xlPasteValues

OS.Cells(i, "B").EntireRow.Delete

'j3 = j3 + 1

Else:

If (OS.Cells(i, CD).Value <= D4 And OS.Cells(i, CD).Value >= D3) Then

'copie la ligne et on la déplace dans T4, puis on la supprime dans le fichier d'origine

Set DEST = OD4.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)

OS.Cells(i, "B").Resize(1, 21).Copy

DEST.PasteSpecial xlPasteValues

OS.Cells(i, "B").EntireRow.Delete

'j4 = j4 + 1

Else: 'rien faire'

End If

End If

End If

End If

Next

OD1.Columns("S:T").NumberFormat = "m/d/yyyy" 'Mise en forme au format Date courte

OD1.Columns("A:T").EntireColumn.AutoFit 'Ajuster la largeur des cellules

OD2.Columns("S:T").NumberFormat = "m/d/yyyy"

OD2.Columns("A:T").EntireColumn.AutoFit

OD3.Columns("S:T").NumberFormat = "m/d/yyyy"

OD3.Columns("A:T").EntireColumn.AutoFit

OD4.Columns("S:T").NumberFormat = "m/d/yyyy"

OD4.Columns("A:T").EntireColumn.AutoFit

End Sub

Voila, voila, désolé pour le pavé j'espère avoir structuré mon code suffisamment pour que tout le monde puisse le comprendre.

Envoyer vos remarques/idées !

Merci d'avance !