Bonjour à tous ! j'ai un problème sur mon code. Je passe par un tableau pour retranscrire les données (selon la méthode de monsieur boisgontier alain). Mais je n'arrive pas à faire fonctionner.
Je passe par beaucoup de moyens détournés afin que même si les données bougent, cela fonctionne toujours mais je n'arrive pas à voir où est mon erreur ? VBA me dit tableau attendu
Une âme charitable s'il vous plaît ?

Merciiii


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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 
Sub quinemarchepas()
 
  Application.ScreenUpdating = False
 
Dim principal As ThisWorkbook
Dim repertoire As String, fichier As String
Dim myrg As Range
Dim delai_pos As Long, delai_h As Long, lastrow As Long, lastcolumn As Long
  'empêche l'actualisation de l'écran
  Application.ScreenUpdating = False
  'définit le fichier actif comme fichier principal
  Set principal = ThisWorkbook
  repertoire = "L:\Stat_Activite\TDB xxx\" & annéetdb & moistdb & "\MO"
 
  ChDrive "L"
  ChDir repertoire
  fichier = Dir(repertoire & "\" & "xxx.xls")
  Workbooks.Open fichier
 
'définir le dictionnaire pour insérer les données
Set mydico = CreateObject("Scripting.dictionary")
 
'chercher la cellule statut
Cells.Find(What:="xxx", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
  xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
  , SearchFormat:=False).Activate
 
'definir la position de statut
delai_pos = ActiveCell.Column
delai_h = ActiveCell.Row
 
Cells.Find(What:="xxx", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
  xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
  , SearchFormat:=False).Activate
 
'definir la position de statut
xxx = ActiveCell.Column
 
lastrow = Cells(delai_h, delai_pos).End(xlDown).Row
lastcolumn = Cells(delai_h, delai_pos).End(xlToRight).Column
Set myrg = Range(Cells(delai_h, delai_pos), Cells(lastrow, lastcolumn))
 
  For i = LBound(myrg) To UBound(myrg)
 
  mydico.Item(myrg(i, 1)) = Array(myrg(i, 1), myrg(i, 2), myrg(i, 3))
 
  Next i
 
  Application.ScreenUpdating = True
 
ActiveWorkbook.Close False
 
Workbooks("Tableau de correspondances.xlsm").Activate
 
Sheets("alim").Activate
 
b = Application.trnasplose(Application.Transpose(mydico.items))
[F2].Resize(UBound(mydico), UBound(b, 2)) = b
 
 
  Application.ScreenUpdating = True
 
 
End Sub