VBA: consolidation des diverrs données dans une meme feuille
Bon courage acide sulfurique... Moi j'ai abandonné.
maroua a écrit :alors juste quand je lance ma macro j'ai ce message " Subscript out of range" rien d'autre
bonjour,
quand tu reçois ce message d'erreur, un pop-up s'affiche. et tu peux choisir end (terminer ?) ou debug( débogage ?)
si tu choisis débogage, l'éditeur VBA s'ouvre et la ligne en erreur est affichée en jaune.
quelle est cette ligne ?
justement, j'ai juste le choix entre "OK" et "Help" et quand je clic sur ok rien ne se passe
maroua a écrit :justement, j'ai juste le choix entre "OK" et "Help" et quand je clic sur ok rien ne se passe
et quand tu cliques sur help ?
je suis redirigé vers cette page dont le message est le suivant
"Subscript out of range (Error 9)
This page is specific to the Visual Basic for Applications (VBA) Language Reference for Office 2010.
Elements of arrays and members of collections can only be accessed within their defined ranges. This error has the following causes and solutions:
You referenced a nonexistent array element. The subscript may be larger or smaller than the range of possible subscripts, or the array may not have dimensions assigned at this point in the application. Check the declaration of the array to verify its upper and lower bounds. Use the UBound and LBound functions to condition array accesses if you're working with arrays that are redimensioned. If the index is specified as a variable, check the spelling of the variable name.
You declared an array but didn't specify the number of elements. For example, the following code causes this error:
Dim MyArray() As Integer
MyArray(8) = 234 ' Causes Error 9.
Visual Basic doesn't implicitly dimension unspecified array ranges as 0 - 10. Instead, you must use Dim or ReDim to specify explicitly the number of elements in an array.
You referenced a nonexistent collection member. Try using the For Each...Next construct instead of specifying index elements.
You used a shorthand form of subscript that implicitly specified an invalid element. For example, when you use the ! operator with a collection, the ! implicitly specifies a key. For example, object!keyname.value is equivalent to object.item(keyname).value. In this case, an error is generated if keyname represents an invalid key in the collection. To fix the error, use a valid key name or index for the collection.
For additional information, select the item in question and press F1 (in Windows) or HELP (on the Macintosh)."
bon
on n'est pas sorti de l'auberge !
et quand tu executes ta macro pas à pas ?
ai-je bien compris que tu as une version excel en anglais ?
pour faire du pas à pas
faire alt-F8, choisir la macro, puis cliquer sur step into, dans vba faire F8 pour exécuter les instructions une à une. puis dis-moi sur quelle instruction ça coince.
oui, en effet c'est une version anglaise d'excel
ca coince sur" Path = ThisWorkbook.Path"
Bonjour,
peux-tu joindre ton fichier ?
ci joint mon fichier
bonjour,
l'instruction qui donne l'erreur est
ThisWorkbook.Sheets(Target_Worksheet).Cells.ClearCe message d'erreur indique que la feuille target_worksheet n'existe pas dans ton classeur.
verifie que ces 3 feuilles existent.
tabl(1) = "Actual GB AAA"
tabl(2) = "Actual GB BBB"
tabl(3) = "Actual GB CCC"
ok je verifie et je reviens vers toi
en fait les feuilles
tabl(1) = "Actual GB AAA"
tabl(2) = "Actual GB BBB"
tabl(3) = "Actual GB CCC"
se trouvent dans des fichiers autres que ce fichiers que je t'ai envoyé . ces trois fichiers fichiers sont mes fichiers sources.
le but etant tranferer toutes les données de ces trois fichiers dans la feuille "Actual GB" du fichier que je t'ai envoyé.
Par consequent je ne vois pas l'interet d'ajouter les trois feuilles dans ce fichier que je t'ai envoyé.
Je ne sais pas si on se comprend?
NB: juste pour info j'ai plusieurs fichiers dans lesquels j'ai une de ces trois feuilles.
Merci
maroua a écrit :Par consequent je ne vois pas l'interet d'ajouter les trois feuilles dans ce fichier que je t'ai envoyé.
Merci
moi non plus, mais c'est ce que tu as demandé.
bonjour,
un essai à l'aveugle ...
Sub HC_Global()
'Variables Declaration
Dim Path As String, File As String
Dim Worksheet As Worksheet
Dim Target_Worksheet As String
Dim OK_Worksheet As Boolean, Start As Boolean
Dim Name As Name
Dim FirstLine As Long, LastLine As Long, LastLineTarget As Long
Dim FirstColumn As Long, LastColumn As Long
Target_Worksheet = "Actual GB"
ThisWorkbook.Sheets(Target_Worksheet).Cells.Clear
Path = ThisWorkbook.Path
Start = True
'If unsaved file, then no path => always save the file before executing the macro
If Path <> "" Then
'Filters only on Excel files, starting with "Actual GB"
File = Dir(Path & "\ACTUAL GB*.*xls*")
'Only "esthetic" : improves speed and processing appearance (deactivating sreen update)
Application.ScreenUpdating = False
Do While File <> ""
If File <> ThisWorkbook.Name Then
Workbooks.Open Filename:=Path & "\" & File, ReadOnly:=True, UpdateLinks:=False
Application.DisplayAlerts = False
'Test if worksheet exists
OK_Worksheet = False
For Each Worksheet In Workbooks(File).Sheets
If Left(Worksheet.Name, 9) = Target_Worksheet Then OK_Worksheet = True: Exit For
Next
'If worksheet OK => copies worksheet content to "Global" file
If OK_Worksheet Then
Worksheet.Unprotect Password:="FCII"
Worksheet.Columns.Ungroup
Worksheet.AutoFilterMode = False
'Sets the range to copy in "Global"
FirstLine = Lookforfirstline(Workbooks(File), Target_Worksheet) + 1
If Not Start Then FirstLine = FirstLine + 1
Start = False
LastLine = LookforLastline(Workbooks(File), Target_Worksheet)
FirstColumn = LookforFirstColumn(Workbooks(File), Target_Worksheet)
LastColumn = LookforLastColumn(Workbooks(File), Target_Worksheet)
LastLineTarget = LookforLastline(ThisWorkbook, "Actual GB") + 1
'No copy of the header if not the first file copied
With Workbooks(File).Sheets(Target_Worksheet)
.Range(.Cells(FirstLine, FirstColumn).Address & ":" & .Cells(LastLine, LastColumn).Address).Copy Destination:=ThisWorkbook.Sheets("Actual GB").Range("A" & LastLineTarget)
End With
'Deletes named cells
For Each Name In ThisWorkbook.Names
Name.Delete
Next
Start = False
End If
Worksheet.Protect Password:="FCII"
Workbooks(File).Close False
End If
File = Dir
Loop
'Breaks Links
on error resume next
Dim Link As Variant
For Each Link In ActiveWorkbook.LinkSources
ActiveWorkbook.BreakLink Name:=Link, Type:=1
Next
'Deletes Data/Validation
Sheets("Actual GB").Select
Cells.Validation.Delete
'Deletes Conditional Formatting
Sheets("Actual GB").Select
Cells.FormatConditions.Delete
on error goto 0
'Sorts data by Name & First Name
Cells.Select
ActiveWorkbook.Worksheets("Actual GB").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Actual GB").Sort.SortFields.Add Key:=Range( _
"l2:l1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Actual GB").Sort.SortFields.Add Key:=Range( _
"m2:m1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Actual GB").Sort
.SetRange Rows("1:01048576")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' Filters
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter
Sheets("Updates").Select
' Re-activates Display Alerts
Application.DisplayAlerts = True
' Re-activates screen update
Application.ScreenUpdating = True
End Ifbonjour,
j'ai essayer avec la nouvelle ecriture que tu m'as envoyé mais ca bloque a ce niveau "For Each Link In ActiveWorkbook.LinkSources"
Sub HC_Global()
'Variables Declaration
Dim Path As String, File As String
Dim Worksheet As Worksheet
Dim Target_Worksheet As String
Dim OK_Worksheet As Boolean, Start As Boolean
Dim Name As Name
Dim FirstLine As Long, LastLine As Long, LastLineTarget As Long
Dim FirstColumn As Long, LastColumn As Long
Target_Worksheet = "Actual GB"
ThisWorkbook.Sheets(Target_Worksheet).Cells.Clear
Path = ThisWorkbook.Path
Start = True
'If unsaved file, then no path => always save the file before executing the macro
If Path <> "" Then
'Filters only on Excel files, starting with "Actual GB"
File = Dir(Path & "\ACTUAL GB*.*xls*")
'Only "esthetic" : improves speed and processing appearance (deactivating sreen update)
Application.ScreenUpdating = False
Do While File <> ""
If File <> ThisWorkbook.Name Then
Workbooks.Open Filename:=Path & "\" & File, ReadOnly:=True, UpdateLinks:=False
Application.DisplayAlerts = False
'Test if worksheet exists
OK_Worksheet = False
For Each Worksheet In Workbooks(File).Sheets
If Left(Worksheet.Name, 9) = Target_Worksheet Then OK_Worksheet = True: Exit For
Next
'If worksheet OK => copies worksheet content to "Global" file
If OK_Worksheet Then
Worksheet.Unprotect Password:="FCII"
Worksheet.Columns.Ungroup
Worksheet.AutoFilterMode = False
'Sets the range to copy in "Global"
FirstLine = Lookforfirstline(Workbooks(File), Target_Worksheet) + 1
If Not Start Then FirstLine = FirstLine + 1
Start = False
LastLine = LookforLastline(Workbooks(File), Target_Worksheet)
FirstColumn = LookforFirstColumn(Workbooks(File), Target_Worksheet)
LastColumn = LookforLastColumn(Workbooks(File), Target_Worksheet)
LastLineTarget = LookforLastline(ThisWorkbook, "Actual GB") + 1
'No copy of the header if not the first file copied
With Workbooks(File).Sheets(Target_Worksheet)
.Range(.Cells(FirstLine, FirstColumn).Address & ":" & .Cells(LastLine, LastColumn).Address).Copy Destination:=ThisWorkbook.Sheets("Actual GB").Range("A" & LastLineTarget)
End With
'Deletes named cells
For Each Name In ThisWorkbook.Names
Name.Delete
Next
Start = False
End If
Worksheet.Protect Password:="FCII"
Workbooks(File).Close False
End If
File = Dir
Loop
'Breaks Links
on error resume next
Dim Link As Variant
For Each Link In ActiveWorkbook.LinkSources
ActiveWorkbook.BreakLink Name:=Link, Type:=1
Next
'Deletes Data/Validation
Sheets("Actual GB").Select
Cells.Validation.Delete
'Deletes Conditional Formatting
Sheets("Actual GB").Select
Cells.FormatConditions.Delete
on error goto 0
'Sorts data by Name & First Name
Cells.Select
ActiveWorkbook.Worksheets("Actual GB").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Actual GB").Sort.SortFields.Add Key:=Range( _
"l2:l1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Actual GB").Sort.SortFields.Add Key:=Range( _
"m2:m1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Actual GB").Sort
.SetRange Rows("1:01048576")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' Filters
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter
Sheets("Updates").Select
' Re-activates Display Alerts
Application.DisplayAlerts = True
' Re-activates screen update
Application.ScreenUpdating = True
End If
juste voila tous mes fichiers mets les toutes dans un meme dossier et essaye de lancer la macro.
peux etre ainsi tu sauras mieux ce qu'il faux faire
[attachment=0]
bonjour!
là ca a l'air de fonctionner mais pour un seul onglet
pas pour les trois
voici mes trois fichiers et toutes les données de chaque feuille Actual GB AAA, Actual GB BBB et Actual GB CCC doivent etre dans le fichier avec macro dans la feuille Actual GB en lancant la macro c'est pas encore le cas pour le moment malheuresement
tous les fichiers etant dans le meme dossier meme celui avec la macro!
je me rends compte que jen'est pas ete plus explicite avant ! desole encore mais cette fois j'espere que ca va
merci encore
la macro bloque a ce niveau
Worksheet.Protect Password:="FCII"
c'est en effet plus simple quand on dispose de l'info.