Découper un fichier Excel

Bonjour,

Ce code là me permet de découper un fichier excel en d'autres fichiers excels selon une colonne ''W''

j'ai eu un erreur à ce niveau :

sh.[AA].RemoveDuplicates Columns:=Array(1), Header:=xlYes

Erreur 420 Object required

Option Explicit

Sub creation_fichiers()
Dim i As Integer
Dim sh, Dlg, plg
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set sh = Sheets(1)
Dlg = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set plg = sh.Range("A5:W" & Dlg)
sh.Range("W6" & Dlg).Copy sh.[AA1]
sh.[AA].RemoveDuplicates Columns:=Array(1), Header:=xlYes
sh.[AC1] = sh.[W5]

For i = 2 To sh.Cells(Rows.Count, "AA").End(xlUp).Row
Workbooks.Add
sh.[AC2] = sh.Range("AA" & i)
plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=sh.Range("AC1:AC2"), CopyToRange:=ActiveWorkbook.Sheets(1).Range("A1:W1")

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & sh.Range("AB" & i) & "-" & sh.Range("AA" & i) & ".xls", FileFormat:=xlExcel8

ActiveWorkbook.Close False
Next i
sh.[AA:AC].ClearContents
End Sub

Bonjour,

L'erreur provient du fait que le Tableau ("Array" en anglais !) n'est pas déclaré.

Un array possède en général des éléments en début de code, je ne connais pas la méthode RemoveDuplicates mais pourquoi ne pas utiliser des variables tableau (variant) suivi de fonction .Resize() pour récupérer toutes les données souhaitées rapidement (surtout si nbreuses : car variables tableau = gain de temps d'execution !!).

Dans l'attente d'un fichier exemple si possible.

A dispo (peut etre pas immédiate)

bonjour,

essaie

sh.columns("AA").RemoveDuplicates Columns:=Array(1,1), Header:=xlYes

Bonjour merci pour votre aide je l'ai essayé ça marche pas aussi

je vous mets en pieces jointe le fichier Excel

re bonjour,

correction

sh.columns("AA").RemoveDuplicates Columns:=Array(1), Header:=xlYes

Merci ça fonctionne mais apparement voici le vrai probléme ; office ne prend pas en charge ce caractére ``/`` , il a ete remplacé par un espace

Nomfich = sh.Range("AA" & i) & "-" & Replace(sh.Range("AA" & i), "/", " ") & ".xls"

l'execution s'arrête a cette ligne des que il croise une description qui porte ce caractére ``/``

bonjour,

le problème n'est pas office mais windows qui n'accepte pas certains caractères spéciaux dans le nom de fichier, dont le "/" qui est un indicateur de sous-répertoire.

regarde si cela peut te convenir

Nomfich = sh.Range("AA" & i) & "-" & sh.Range("AA" & i) & ".xls"
nomfich=replace(nomfich,"/","")

Merci beaucoup H2so4 (Sulfuric acid) ça fonctionne super bien , mais je demande si tu peux me répondre pourquoi ça marche pas avec ceci alors que c'est la même chose dans le fond .

Nomfich = sh.Range("AA" & i) & "-" & Replace(sh.Range("AA" & i), "/", " ") & ".xls"

bonsoir,

Nomfich = sh.Range("AA" & i) & "-" & Replace(sh.Range("AA" & i), "/", " ") & ".xls"

si range("AA" & i) contient "12/15/60"

nomfich contiendra "12/15/60-12 15 60.xls"

tandis qu'avec ceci

Nomfich = sh.Range("AA" & i) & "-" & sh.Range("AA" & i) & ".xls"
nomfich=replace(nomfich,"/","")

nomfich contiendra "121560-121560.xls"

Merci Beaucoup pour éclaircissement , pour le moment le code fonctionne super bien sauf que j'ai des données qui sont situés sur ''A1:H1'' j'aimerais qu'ils seraint copié dans les autres copies aussi ,

j'ai essayé de modifié cette ligne de code

Set plg = sh.Range("A1:T"  & Dlg)

mais ça m'a copié seulement ces données la :/

Sub creation_fichiers()
Dim i As Integer
Dim sh, Dlg, plg
Dim Nomfich$
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set sh = Sheets(1)
Dlg = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set plg = sh.Range("A1:T1" & "A1:T1" & Dlg)
sh.Range("T6:T" & Dlg).Copy sh.[AA1]
sh.Columns("AA").RemoveDuplicates Columns:=Array(1), Header:=xlYes
sh.[AB1] = sh.[T5]

For i = 2 To sh.Cells(Rows.Count, "AA").End(xlUp).Row
Workbooks.Add
sh.[AB2] = sh.Range("AA" & i)
plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=sh.Range("AB1:AB2"), CopyToRange:=ActiveWorkbook.Sheets(1).Range("A1:T1" & "A1:T1")
Nomfich = (sh.Range("AA" & i)) & ("- Actings, Assignments") & ".xls"
Nomfich = Replace(Nomfich, "/", "")

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Nomfich, FileFormat:=xlExcel8

ActiveWorkbook.Close False
Next i
sh.[AA:AC].ClearContents

MsgBox (" Vos fichiers ont été bien traités avec succès ")
End Sub