Erreur dans une macro que je n'identifie pas
cooljuly44
-
cooljuly -
cooljuly -
Bonjour,
j'ai un petit soucis avec ma macro. Elle se lance bien mais j'ai un soucis lors de la copie car elle ne copie pas les lignes que je désire.
c'est une macro qui sert à copier toutes les lignes des autres fichiers (a partir de la ligne 1) dans le fichier conso (à partir de D1)
mais avant de copier, elle doit vérifier que les lignes 1 de tous les fichiers correspondent bien à la ligne 1 de conso. Si c'est pas le cas, elle doit noter le nom du fichier en erreur dans l'onglet approprié.
mon soucis c'est qu'elle copie les titres de la ligne 1 et ne copie pas à partir de D1 (j'aurais une rechercheV dans les colonnes A B C après)
le fichier conso avec la macro : http://www.cjoint.com/c/FEEnQqDcicw
un exemple de fichier bon :http://www.cjoint.com/c/FEEnRfrOdjw
et un en erreur : http://www.cjoint.com/c/FEEnRZWC42w
si quelqu'un peut éclairer ma lanterne :)
merci par avance
j'ai un petit soucis avec ma macro. Elle se lance bien mais j'ai un soucis lors de la copie car elle ne copie pas les lignes que je désire.
c'est une macro qui sert à copier toutes les lignes des autres fichiers (a partir de la ligne 1) dans le fichier conso (à partir de D1)
mais avant de copier, elle doit vérifier que les lignes 1 de tous les fichiers correspondent bien à la ligne 1 de conso. Si c'est pas le cas, elle doit noter le nom du fichier en erreur dans l'onglet approprié.
mon soucis c'est qu'elle copie les titres de la ligne 1 et ne copie pas à partir de D1 (j'aurais une rechercheV dans les colonnes A B C après)
le fichier conso avec la macro : http://www.cjoint.com/c/FEEnQqDcicw
un exemple de fichier bon :http://www.cjoint.com/c/FEEnRfrOdjw
et un en erreur : http://www.cjoint.com/c/FEEnRZWC42w
si quelqu'un peut éclairer ma lanterne :)
merci par avance
3 réponses
-
bonjour, je viens de changer des choses dans mon code et je n'ai toujours pas le résultat escompté. je dois faire une erreur bête mais je n'arrive pas à l'identifier même avec le pas à pas
Sub synthèseClasseurs()
'
'determination des variables
Dim ClassImp As String
Dim wImp As Workbook, wRecap As Workbook
Dim fImp As Worksheet
Dim derlignRec As Long, derlignImp As Long
Dim Repertoire As String
Dim dImp As Object
Dim tRec(), tImp()
Dim i As Variant, j As Variant
Dim N As Name
'--- Limitation des applications.
Application.ScreenUpdating = False
'Set maitre = ActiveWorkbook
Set wRecap = ThisWorkbook
Repertoire = ThisWorkbook.Path
derlignRec = fRec.Cells.Find("*", , , , xlByRows, xlPrevious).Row
ClassImp = Dir(Repertoire & "\*.xls*") ' premier fichier
tRec = fRec.Range("D1:S1")
'--- On boucle les fichiers.
Set dImp = CreateObject("Scripting.Dictionary")
Do While ClassImp <> "" ' Pour chaque fichier
If ClassImp <> ThisWorkbook.Name Then
'- On ouvre le fichier.
Set wImp = Workbooks.Open(Filename:=Repertoire & "\" & ClassImp, UpdateLinks:=2)
derlignImp = 0
Set wImp = ActiveWorkbook: Set fImp = ActiveSheet
For Each N In ActiveWorkbook.Names: N.Delete: Next
With fImp
'- On véfie la ligne 1
tImp = .Range("A1:P1")
For i = LBound(tRec) To UBound(tRec)
If tRec(i, 1) <> tImp(i, 1) Then dImp(wImp.Name) = "": GoTo Suite
Next i
' on enregistre la dernière ligne
derlignImp = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
'on copie les lignes
.Range(Cells(2, 1), Cells(derlignImp)).Copy fRec.Cells(derlignRec, 4)
End With
Suite:
wImp.Close False
End If
ClassImp = Dir ' fichier suivant
'on recalcule la dernière ligne importé
derlignRec = fRec.Cells.Find("*", , , , xlByRows, xlPrevious).Row
Loop
'--- Limitation des applications.
Application.ScreenUpdating = True
'--- On affiche la liste des fichiers non importés dans la feuille "Fichiers en erreur"
Sheets("Fichiers en erreur").Select
Range("A1").Select
ActiveCell.Value = "Nom du fichier en erreur"
For Each j In dImp.Keys
' Mess = Mess & j & Chr(13)
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
ActiveCell.Value = j
Next j
'Call calculs
End Sub
quelqu'un voit ce qui cloche ?
merci par avance -
Bonjour,
j'effectuerai cette modification
' on enregistre la dernière ligne
derlignImp = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
dercolnImp = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
'on copie les lignes
.Range(Cells(2, 1), Cells(derlignImp, dercolnImp)).Copy fRec.Cells(derlignRec, 4)
-
modification à effectuer
'- On véfie la ligne 1
tImp = .Range("A1:P1")
For i = LBound(tRec, 2) To UBound(tRec, 2)
If tRec(1, i) <> tImp(1, i) Then dImp(wImp.Name) = "": GoTo Suite
amélioration proposée
'--- On affiche la liste des fichiers non importés dans la feuille "Fichiers en erreur"
Sheets("Fichiers en erreur").Select
Range("A1").Value = "Nom du fichier en erreur"
Range("A1").Offset(1).Resize(dImp.Count).Value = Application.Transpose(dImp.Keys)
