Discussion :

[casefayere]

Bon WE et content de t'avoir rendu service, j'espère simplement que tu comprendras le code et que les instructions pourront te servir à d'autres occasions, n'oublies pas de cliquer sur

[olivverte]

Bonjour casefayere,

Votre macro fonctionne vraiment bien, c'est génial. Néanmoins je me suis heurté à un problème que nous n'avons pas pensé.
Lorsqu'il n'y a rien à importer, il y a un message d'erreur qui apparaît. "L'indice n'appartient pas à la sélection", à partir de la ligne 35.

J'ai tenté de faire un If Tbcopié = 0, then Msgbox "Rien à importer" puis Exit sub à partir de la ligne 34 mais cela ne marche pas.

Où pourrait-on mettre ce message et la sortie de la procédure dans la macro, s'il n'y a aucun élément à importer ?

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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub Copier_Valeurs()
 
'Efface les derniers imports sur la feuille "import"
With Sheets("Import")
    Range("Donnees_importees").ClearContents
End With
'donc ci-dessous les variables dûment déclarées
Dim Nb As Long
Dim x As Long, y As Long
'ci-dessous des tableaux, tbGeneral reprendra toutes les données dans les colonnes concernées
'J'ai supprimé Plg qui ne sert pas à grand-chose
Dim TbGeneral, TbCopié(), Dl As Long, TbFinal()
    With Sheets("ABSENCES") 'donc données de la feuille absences
      Dl = .Range("G" & .Rows.Count).End(xlUp).Row 'dernière cellule renseignée en col G
      TbGeneral = .Range("G5:X" & Dl) 'plage à traiter
      Nb = 0 ' je mets ou remet, par sureté cette variable à 0
           For x = 1 To UBound(TbGeneral, 1) 'une boucle qui parcoure tout TbGeneral, UBound(TbGeneral, 1) représente la dernière écriture de la première dimension
          ' voir les tuto sur les manips des tableaux
             For y = 16 To 18 Step 2 'une boucle intégrée qui parcoure une ligne de date, en incrémentant de 2
               If IsDate(TbGeneral(x, y)) Then 'donc 1ere écriture vérifiée (est-ce une date) tbGeneral(1,22), deuxième tbGeneral(1,24)
                 'ci-dessous, si c'est une date
                 'If Month(CDate(TbGeneral(x, y))) = 1 Then 'si le mois de la date = 1
                   Nb = Nb + 1 'on ajoute 1 à la variable Nb si la condition est remplie
                   ReDim Preserve TbCopié(1 To 4, 1 To Nb) 'on redimensionne le tableau TbCopié dans sa deuxième dimension (impossible dans la 1ère quand 2 dimensions)
                   TbCopié(1, Nb) = TbGeneral(x, y) 'au début, TbCopié(1,1) = TbGeneral(1,26) date début
                   TbCopié(2, Nb) = TbGeneral(x, y + 1) 'au début, TbCopié(2,1) = TbGeneral(1,27) date fin
                   TbCopié(3, Nb) = TbGeneral(x, 6) 'col Nature Arrêt
                   TbCopié(4, Nb) = TbGeneral(x, 1) 'au début, TbCopié(3,1) = TbGeneral(1,1)'matricule
                 'End If
               End If
             Next y
           Next x
    End With
'une fois les données copiées dans TbCopié
    ReDim TbFinal(1 To UBound(TbCopié, 2), 1 To 4) 'on dimensionne TbFinal (on peut au départ sur la 1ere dimension)
    For x = 1 To UBound(TbFinal, 1) 'une boucle qui reprend les données de TbCopié
      TbFinal(x, 1) = TbCopié(4, x) 'au début TbFinal(1,1)matricule
      TbFinal(x, 2) = TbCopié(1, x) 'au début TbFinal(1,2)date début
      TbFinal(x, 3) = TbCopié(2, x) 'au début TbFinal(1,3)date fin
      TbFinal(x, 4) = TbCopié(3, x) 'au début TbFinal(1,4)code évènement
    Next x
 
    Sheets("Import").Range("A2:D2").Resize(UBound(TbFinal, 1)) = TbFinal 'je rends le résultat à la plage en feuil "01"
'pour resize, voir l'aide
End Sub

[casefayere]

Bonjour,

Code :

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

1
2
3
4
5
6
7
8
9
...
    End With
    If Nb = 0 Then
      MsgBox "aucunes données à copier"
      Exit Sub
    End If
    ReDim TbFinal(1 To UBound(TbCopié, 2), 1 To 4)
 
...

ça devrait fonctionner

Bonne journée

[olivverte]

Merci beaucoup, c'est impec.

Cordialement,