Problème avec macro compilation de données

sknd2010

XLDnaute Nouveau
Bonjour tout le monde,

J'ai un soucis avec macro que j'utilisais pour compiler plusieurs fichiers Excel.
cependant depuis que j'ai protégé la feuille ou se trouve les informations à importer, voici le message d'erreur qui s'affiche :
Erreur d'éxécution '1004'
La méthode Insert de la classe Range a échoué


Et voici le code concerné : Selection.Insert Shift:=xlToRight

Quand je j'enlève la protection tout redevient normal.
Quelqu'un peut-il m'aider à trouver une solution?

Merci d'avance
 

Efgé

XLDnaute Barbatruc
Re : Problème avec macro compilation de données

Bonjour sknd2010,
Une méthode mot de passe Toto:
Code:
[COLOR=blue]Sub[/COLOR] Test()
Sheets("Feuil2").Unprotect ("Toto")
[COLOR=green]'La macro[/COLOR]
Sheets("Feuil2").Protect ("Toto")
[COLOR=blue]End Sub[/COLOR]
Cordialement
 

sknd2010

XLDnaute Nouveau
Re : Problème avec macro compilation de données

voici le code macro complet :
Sub protection()
Sheets("feuil12").Unprotect ("toto")
Sub ImportXLSFile()
'Dim ceclasseur As String
'Dim monrépertoire As String
'Dim ii As Integer
'monrépertoire = "nom du répertoire contenant les fichiers .txt à importer"


choisirRepertoire
ceclasseur = ThisWorkbook.Name

Set fc = CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Files
If fc.Count > 0 Then 'il y a des fichiers
ii = 0
For Each f1 In fc
If Right(f1.Name, 3) = "xls" Or Right(f1.Name, 3) = "XLS" Then 'c'est un fichier texte
'ii = ii + 1
nomxls = f1.Name
ii = ActiveSheet.Range("C65536").End(xlUp).Row

'Workbooks.OpenText Filename:= _
chemin & "\" & f1.Name, Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Semicolon:=True
'Workbooks.Open Filename:=f1.Name

Workbooks.Open Filename:=chemin & "\" & nomxls 'inclu_nom_fichier début
Sheets("ONGLET DE SAISI").Select
derligne = ActiveSheet.Range("C65536").End(xlUp).Row
Range("A1:A" & derligne).Select
Selection.Insert Shift:=xlToRight
Selection.FormulaR1C1 = f1.Name
'inclu_nom_fichier fin
derligne = ActiveSheet.Range("C65536").End(xlUp).Row

'Rows(1).Copy Workbooks(ceclasseur).Sheets(1).Range("A" & ii + 1)
If derligne > 17 Then
Rows(17 & ":" & derligne).Copy
Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1).PasteSpecial Paste:=xlPasteValues
Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1).PasteSpecial Paste:=xlPasteFormats
End If

End If
Next
End If


'Columns("A:IV").Select
'Cells.EntireColumn.AutoFit
Range("A1").Select

Sheets("feuil12").Protect ("toto")

End Sub


par contre je n'arrive pas à vous joindre un fichier test
 

Efgé

XLDnaute Barbatruc
Re : Problème avec macro compilation de données

Re
Pour poster un fichier c'est ici
pour le problème de la macro, regarde le code ci dessous, en particulier les lignes en rouge,et essai d'adapter à ton cas (je n'ai pas testé, il semble manquer des morceaux et certaines lignes me paraissent "étranges").
Code:
[COLOR=blue]Sub[/COLOR] ImportXLSFile()
[COLOR=blue]Dim[/COLOR] ceclasseur [COLOR=blue]As String[/COLOR]
[COLOR=blue]Dim[/COLOR] monrépertoire [COLOR=blue]As String[/COLOR]
[COLOR=blue]Dim[/COLOR] ii [COLOR=blue]As Integer[/COLOR]
monrépertoire = "nom du répertoire contenant les fichiers .txt à importer"
 
choisirRepertoire[COLOR=green] '????[/COLOR]
ceclasseur = ThisWorkbook.Name
[COLOR=blue]Set[/COLOR] fc = CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Files[COLOR=green] ' Chemin n'est jamais déclaré ????[/COLOR]
[COLOR=blue]If[/COLOR] fc.Count > 0 [COLOR=blue]Then[/COLOR]
    ii = 0[COLOR=green] '????[/COLOR]
    [COLOR=blue]For Each[/COLOR] f1 [COLOR=blue]In[/COLOR] fc
        [COLOR=blue]If[/COLOR] Right(f1.Name, 3) = "xls" [COLOR=blue]Or[/COLOR] Right(f1.Name, 3) = "XLS" [COLOR=blue]Then[/COLOR][COLOR=green] 'c'est un fichier texte (Non C'est un XLS)[/COLOR]
            nomxls = f1.Name
            ii = ActiveSheet.Range("C65536").End(xlUp).Row
            Workbooks.Open Filename:=chemin & "\" & nomxls
            [COLOR=blue]With[/COLOR] Sheets("ONGLET DE SAISI")
              [COLOR=red][B]  .Unprotect ("toto")[/B][/COLOR]
                .Select
                derligne = .Range("C65536").End(xlUp).Row
                [COLOR=blue]With[/COLOR] Range("A1:A" & derligne)
                    .Insert Shift:=xlToRight
                    .FormulaR1C1 = f1.Name
                [COLOR=blue]End With[/COLOR]
                [COLOR=red][B].Protect ("toto")[/B][/COLOR]
            [COLOR=blue]End With[/COLOR]
            [COLOR=blue]If[/COLOR] derligne > 17 [COLOR=blue]Then[/COLOR]
                Rows(17 & " : " & derligne).Copy
                Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1).PasteSpecial Paste:=xlPasteValues
                Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1).PasteSpecial Paste:=xlPasteFormats
            [COLOR=blue]End If[/COLOR]
        [COLOR=blue]End If[/COLOR]
    [COLOR=blue]Next[/COLOR]
[COLOR=blue]End If[/COLOR]
Range("A1").Select
[COLOR=blue]End Sub[/COLOR]
Bon courage
Cordialement
 

sknd2010

XLDnaute Nouveau
Re : Problème avec macro compilation de données

Re,

Cool il commerce à marcher de nouveau. cependant il y a d'autres petits soucis qui réapparaient :
- elle ne colle pas les fichier les uns sur les autres (il laisse 15 lignes d'écart) alors qu'avant elle les collait tous les uns sur les autres.
- sur les feuils importés, la macro colle des lignes en bas aussi.
 

Efgé

XLDnaute Barbatruc
Re : Problème avec macro compilation de données

Re
Une nouvelle tentative:
Code:
[COLOR=blue]Sub[/COLOR] ImportXLSFile()
[COLOR=blue]Dim[/COLOR] ceclasseur [COLOR=blue]As String[/COLOR]
[COLOR=blue]Dim[/COLOR] monrépertoire [COLOR=blue]As String[/COLOR]
[COLOR=blue]Dim[/COLOR] ii [COLOR=blue]As Integer[/COLOR]
monrépertoire = "nom du répertoire contenant les fichiers .txt à importer"
choisirRepertoire[COLOR=green] '????[/COLOR]
ceclasseur = ThisWorkbook.Name
[COLOR=blue]Set[/COLOR] fc = CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Files
[COLOR=blue]If[/COLOR] fc.Count > 0 [COLOR=blue]Then[/COLOR]
    [COLOR=blue]For Each[/COLOR] f1 [COLOR=blue]In[/COLOR] fc
        [COLOR=blue]If[/COLOR] UCase(Right(f1.Name, 3)) = "XLS" [COLOR=blue]Then[/COLOR]
            nomxls = f1.Name
            ii = ActiveSheet.Range("C65536").End(xlUp).Row + 1
            Workbooks.Open Filename:=chemin & "\" & nomxls
 
            [COLOR=blue]With[/COLOR] Sheets("ONGLET DE SAISI")
                .Unprotect ("toto")
                .Select
                derligne = .Range("C65536").End(xlUp).Row
                [COLOR=blue]With[/COLOR] Range("A1:A" & derligne)
                    .Insert Shift:=xlToRight
                    .FormulaR1C1 = f1.Name
                [COLOR=blue]End With[/COLOR]
                .Protect ("toto")
            [COLOR=blue]End With[/COLOR]
 
            [COLOR=blue]If[/COLOR] derligne > 17 [COLOR=blue]Then[/COLOR]
                Sheets("ONGLET DE SAISI").Rows("17:" & derligne).Copy
                [COLOR=blue]With[/COLOR] Workbooks(ceclasseur).ActiveSheet.Range("A" & ii)
                    .PasteSpecial Paste:=xlPasteValues
                    .PasteSpecial Paste:=xlPasteFormats
                [COLOR=blue]End With[/COLOR]
            [COLOR=blue]End If[/COLOR]
        [COLOR=blue]End If[/COLOR]
    [COLOR=blue]Next[/COLOR]
[COLOR=blue]End If[/COLOR]
Range("A1").Select
[COLOR=blue]End Sub[/COLOR]
Cordialement
 

sknd2010

XLDnaute Nouveau
Re : Problème avec macro compilation de données

Re,

Malheureusement ca ne marche toujours pas bien. Alors pour plus d'information; j'ai une dizaine de fichier client que je mets dans un fichier enrégistré dans le disque dur. La macro va aller cherche ses fichiers là dans le disque dure, aller à l'onglet "ONGLET de SAISI" et copié les infos à partir de la ligne 17.
Elle me collais ainsi les fichiers uns à la suite des autres.
Maintenant il colle le premier sans soucis (donc le probleme de la protection est résolu) mais après il saute 15 lignes (ce qui correspond à mon avis au ligne juste au dessus de la barre de titre XX1). ca c un soucis. le deuxieme soucis c'est qu'elle (la macro) colle les aiutres fichier SUR le deuxième (ce qui fait que mm si j'ai 10 fichier j'en aurai que deux sur le fichier compilé.
 

sknd2010

XLDnaute Nouveau
Re : Problème avec macro compilation de données

Re Efgé,

Malheureument je me suis emballer un peu trop vite.
En fait la macro beug s'il y a des cellules cachées par un filtre.
je sais que le code pour afficher toutes les cellules c 'est : ActiveSheet.ShowAllData mais j'arrive pas à bien l'intégrer dans la macro

Merci par avance
 

Discussions similaires