XL 2016 Incrémentation de valeur avec VBA

[yapad05]

Bonsoir à Tous!

J'ai vraiment besoin d'aide.

J'ai un code VBA qui me permet d'ouvrir plusieurs classeurs, de copier certaines valeurs que je dois normalement coller dans un autre classeur.

Le probleme c'est qu'il n'incrimente pas les valeurs copier. Elles restent toujours à la meme cellule.

Au fait je recois des rapports journaliers que je dois compiler et analyser.

Je vous met le code :


Sub data_base()


Dim wbRecap As Workbook

Dim wsRecap As Worksheet

Dim wbSource As Workbook

Dim wsSource As Worksheet

Dim derlign As Integer

Dim vfichier As Variant

Dim i As Integer, k As Integer

Dim rgrecap As Range


Set wbRecap = ThisWorkbook

Set wsRecap = wbRecap.Sheets(2)


vFichiers = Selectionner_Fichiers(" ")


If Not IsArray(vFichiers) Then

Debug.Print "Aucun fichier sélectionné."

MsgBox "erreur! Aucun/Mauvais fichier sélectionné."

Exit Sub

End If

On Error Resume Next



Application.ScreenUpdating = False


For k = 1 To UBound(vFichiers)


Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichers)




Set wbSource = Workbooks.Open(vFichiers(k))

Set wsSource = wbSource.Sheets(1)


DernLign = wsRecap.Range("A65000").End(xlUp).Offset(1, 0)



wsRecap.Range("C3").Offset(1, 0).Value = wsSource.Range("G18").Value




wbSource.Close

Set wbSource = Nothing

Next k



Application.ScreenUpdating = True
Application.StatusBar = False


End Sub



Function Selectionner_Fichiers(sTitre As String) As Variant

Dim sFiltre As String, bMultiSelect As Boolean


sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
bMultiSelect = True

Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)


End Function

 

[yapad05]

Bonjour @sylvanu et @cp4
@cp4 les fichiers je les recois d'un operateur externe je n'ai aucun moyen d'influencer la dessus
Merci encore a @sylvanu de m'aider encore a avancer sur mon projet

La macro derniere macro que vous avez partager copie effectivement en fonction des dates mais il reste juste un truc, au fait quand tu sélectionnes plusieurs fichiers il laisse une ligne vide avant de copier pour la derniere date j'ai essaye de regler par moi meme mais je n'y suis pas arrive

 

[sylvanu]

Bonsoir,
Avec un petit effort on pourrait avoir un fichier résultat erroné ou même une simple image.
Parce que la, pour comprendre c'est pas simple.
Peut être une piste, n'oubliez pas qu'au départ k est égal à 1, non à 0.

 

[yapad05]

Bon ok voici le type de fichier que je recois chaque jour
Je dois extraire les informations pour chaque jour et faire des analyse

 

[sylvanu]

Bonsoir, et merci, c'est sympa. C'est quand même plus simple.
En fait l'erreur vient du fait que le mécanisme utilisé avant ( sans ranger par lignes datées ) n'est plus utilisable en l'état.
Avant :

.Cells(DL+k, "B") = T352(1, 1)

car on rangeait les infos les unes en dessous des autres. D'où l'indice k=1,2,3 ...
Maintenant on indexe par rapport à la date en colonne A, donc l'indice k ne doit plus entrer en ligne de compte. et cela se simplifie :

'Compressor A
        With Sheets("A")
            .Select
            DL = Application.Match(CLng(DateV4), .Range("A:A"), 0)      ' Où est la date
            If Not IsError(DL) Then                                     ' Si pas de date trouvée, message d'erreur
                .Cells(DL, "B") = T352(1, 1)     ' Transfert tableau
                .Cells(DL, "C") = T352(1, 4)
                .Cells(DL, "D") = T352(1, 8)
                .Cells(DL, "E") = T352(1, 10)
                .Cells(DL, "F") = T352(1, 12)
                .Cells(DL, "G") = T352(1, 15)
                .Cells(DL, "H") = T352(1, 18)
                .Cells(DL, "I") = T352(1, 21)
            Else
                MsgBox "La date n'appartient pas au fichier."
            End If
        End With

J'en ai profité pour rajouter les Compresseur C et D.

 

[yapad05]

Bonsoir @sylvanu
Je vous remercie pour cette aide precieuse j'ai tout ce que je veux pour faire ma base de donnees et pour simplifier mon travail grand merci a vous!

 

[yapad05]

Bonjour à vous !
Bonjour @sylvanu!

Je reviens encore vers toi, tout marchait correctement jusqu'à présent avec les autres fichiers que j'ai traité mais pour ce fichier source je n'arrive pas à copier les données.
La macro marche mais elle ne recopie pas les données du fichier source vers le fichier destinataire meme apres avoir changer le format de la date et le format du fichier

je te les mets en PJ

 

[sylvanu]

Bonjour Yapad,
Je ne sais pour quelle raison exacte ce fichier pose problème. En fait il ne reconnait pas la date Jan-01-2022.
Toutes les dates des autres fichiers ont elles le même format ?

Pour résoudre ce problème spécifique j'ai été obligé de jongler avec les différents format et notation, la seule solution correcte que j'ai trouvé est :

Jour = CLng(CDate((Format(Day(DateF4), "00") & "/" & Format(Month(DateF4), "00") & "/" & Format(Year(DateF4), "0000"))))
Puis
DL = Application.Match(Jour, .Range("A:A"), 0)

Le gros problème maintenant est de savoir si ce calcul de date est compatible des fichiers qui marchaient. Marchent ils encore ?

Dans la négative envoyez aussi un fichier qui marche pour essayer de combiner les deux formats.

 

[yapad05]

Bonsoir @sylvanu!

Désolé de te repondre que maintenant je voulais etre sur avoir essayé toutes les options avant de te recontacter.

Pour la date du 10/01/2022 la macro marche mais pour la date du 06 elle ne reconnait pas la date

 

[sylvanu]

Bonsoir Yapad,
Ma PJ #22 travaille avec le format de fichier que vous m'avez donné en #21.
Or votre format a changé :
PJ#21

PJ#23

La date n'est plus en F4 mais semble être en C4.
Je me demande d'ailleurs comment la 10/2 marche !
Si vous modifiez le format il vous faut modifier le VBA en conséquence. Y compris peut être pour toutes les autres données.

 

[yapad05]

Ok merci