Import de données

Bonjour le forum,

Je peine sur une macro que je n'arrive pas à finaliser.

J'ai fais des formules visant à calculer le nombre de sorties par clients (villes).

J'aimerais intégrer les résultats dans un autre tableau en prenant en compte le jour de la semaine sans additionner les doublons.

Ci joint un exemple avec la macro qui ne fonctionne pas.

Merci pour votre précieuse aide

Bonjour

Suppime d'abord toutes les lignes sous les villes de la feuille Sorties Report (il y a plein de valeurs)

Dim BD As Range, Villes As Range, Valeur As Range, y As Long, I As Integer
Set BD = Sheets("Report Data").Cells(1, 1).CurrentRegion
Set BD = BD.Offset(0, 3).Resize(, BD.Columns.Count - 3)

With Worksheets("Sorties Report")
    y = .Cells(Rows.Count, 1).End(xlUp).Row
    Set Villes = .Range(Cells(5, 1), Cells(y, 8))

    For I = 1 To Villes.Rows.Count
        Set Valeur = BD.Find(What:=Villes.Cells(I, 1).Value)
        If Not Valeur Is Nothing Then Villes.Cells(I, Weekday(Valeur.Offset(0, 8), 2) + 1) = Valeur.Offset(0, 7).Value
    Next I
End With

Merci 78Chris,

Peut on adapter la macro en fonction de la date ?

Dans l'exemple si en A2 (feuille sorties report) il y avait 03/01/2020 faire que les données se mettent dans la colonne Vendredi.

Dans la réalité j'aimerais extraire des données sur plusieurs mois

Merci pour votre aide

Je vous laisse un exemple plus complet.

Ma feuille Sorties Report sera une autre chaque jour, je dois donc classer les données en fonction des semaines et des jours.

Après des heures de recherches je n'y arrive pas malheureusement.

Merci pour votre aide

RE

Elle devait déjà s'adapter au jour mais il y avait une erreur

Si j'ai bien compris il peut y avoir plusieurs dates dans Report Data

Sub SortiesImportData()

Dim BD As Range, Villes As Range, Valeur As Range, y As Long, I As Integer, V As Long
Set BD = Sheets("Report Data").Cells(1, 1).CurrentRegion
Set BD = BD.Offset(0, 3).Resize(, BD.Columns.Count - 3)
Dim LaDate As Date

With Worksheets("Sorties Report")
    LaDate = .Cells(2, 1)
    y = .Cells(Rows.Count, 1).End(xlUp).Row
    Set Villes = .Range(.Cells(5, 1), .Cells(y, 8))

    For I = 1 To Villes.Rows.Count
        V = 0
        Set Valeur = BD.Find(What:=Villes.Cells(I, 1).Value)
        Do
            If Not Valeur Is Nothing Then
                If Valeur.Offset(0, 2).Value <> LaDate Then V = Valeur.Row Else V = -1
            End If
            If V = -1 Then
                Villes.Cells(I, Weekday(Valeur.Offset(0, 2), 2) + 3) = Valeur.Offset(0, 7).Value
            Else
                Set Valeur = BD.FindNext(Valeur)
            End If
        Loop While V <> -1 And Valeur.Row > V
    Next I
End With

End Sub

Sinon change juste dans le précédent code

If Not Valeur Is Nothing Then Villes.Cells(I, Weekday(Valeur.Offset(0, 2), 2) + 3) = Valeur.Offset(0, 7).Value

Hello 78Chris,

Désolé la macro bloque à ce niveau " Set Valeur= BD.FindNext(Valeur)

En fait chaque jours je vais insérer des données dans Report Data, ces données correspondent à une journée (même date), ensuite il faudrait les classer dans la feuille "Sorties Report" selon WK en A1 et la date en A2.

Les données devront donc s'insérer dans les bonnes colonnes en fonction de la date.

J'espère avoir été assez explicite

Merci beaucoup pour ton aide

RE

Sur ton précédent exemple en changeant A2 et certaines dates dans les données source le code que j'ai posté fonctionne très bien.

Cependant il semble depuis le début y avoir un problème dans ton fichier

Je te conseille un copier collage spécial valeurs des données de tes 2 onglets dans une classeur neuf

Pourquoi à propos fusionnes-tu des cellules ?

Cela n'a généralement aucun intérêt et apporte plus de problèmes

Ton processus est flou je ne sais pas ce que signifie WK1 ni son incidence

Tu as 5 jours donc je ne vois pas comment tu peux copier plus de ces 5 jours sans plus d'explications

Bonjour 78Chris,

Les cellules se fusionnent automatiquement dans mon extraction.

Je prends note de tes conseils, je vais chercher une autre solution et reviens sur le forum si jamais.

Bien à toi

RE

A noter que tout cela est sans doute faisable par TCD mais, comme je l'ai dit, tu expliques si peu le contexte et le processus qu'on ne peut être sûr de rien...

C'est bon j'y suis arrivé, tu avais raison le pb était la fusion des cellules.

Le code ci-dessous fonctionne désormais

Set ws1 = Sheets("Sorties Report")

Set ws2 = Sheets("Sorties Data")

Application.ScreenUpdating = False

Set trouve = ws1.Rows(1).Find(What:=ws1.Range("A1").Value, After:=ws1.Cells(1, 1), SearchDirection:=xlNext)

Set PcesProcess = ws1.Rows(3).Find(What:=ws2.Range("K1").Value, After:=trouve.Offset(2, -1), SearchDirection:=xlNext)

iday = Weekday(ws1.Range("A2").Value, vbMonday)

For I = 3 To Range("D5").End(xlDown).Row

Set trouve = ws1.Columns(1).Find(What:=ws2.Cells(I, "D").Value, After:=ws1.Cells(1, 1), SearchDirection:=xlNext)

If Not trouve Is Nothing Then

ws1.Cells(trouve.Row, PcesProcess.Column + iday - 1) = ws2.Cells(I, "K").Value

End If

Next I

Encore merci pour ton aide