[Résolu] VBA copier données d'un fichier à un autre

[mdidish]

Bonjour

J'ai un fichier qui possède plusieurs centaines de colonnes ; chaque colonne correspond à un individu, des données numériques étant listées pour chaque individu.
J'aimerai créer un autre fichier qui ne contiendrait que les données numériques supérieures à un certain seuil (renseigné par l'utilisateur).

J'ai commencé à écrire ce script :
- je filtre la première colonne pour n'afficher que les données supérieures au seuil,
- je copie les données filtrées de la première colonne vers la première colonne du nouveau fichier ;
- puis je recommence pour la deuxième colonne, etc.
Mais j'ai une erreur d'exécution 1004 pour la ligne :
Workbooks("exemple.xlsm").Sheets(1).Range(Cells(1, i), Cells(1, i).End(xlDown)).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Workbooks("Filtre_80.xlsx").Sheets(1).Cells(1, i).

Sub test()
Dim nb_filtre As Integer
Dim new_name As String

Tb_c = Range("IV1").End(xlToLeft).Column
nb_filtre = InputBox("Entrer la valeur seuil", "Filtre petites tailles")
Dir_save = ActiveWorkbook.Path
Application.DefaultSaveFormat = xlWorkbookDefault
Application.Workbooks.Add
new_name = Dir_save & "\Filtre_" & nb_filtre & ".xlsx"
ActiveWorkbook.SaveAs Filename:=new_name

For i = 1 To Tb_c
    Workbooks("exemple.xlsm").Sheets(1).AutoFilterMode = False
    Workbooks("exemple.xlsm").Sheets(1).Range("A1:IV60000").AutoFilter Field:=i, Criteria1:=">" & nb_filtre, Operator:=xlAnd
    Workbooks("exemple.xlsm").Sheets(1).Range(Cells(1, i), Cells(1, i).End(xlDown)).SpecialCells(xlCellTypeVisible).Copy _
    Destination:=Workbooks("Filtre_80.xlsx").Sheets(1).Cells(1, i)
Next

End Sub

D'où vient cette erreur ?
Merci par avance

 

[Staple1600]

Re : VBA copier données d'un fichier à un autre

Bonjour à tous

mdidish
Test OK sur ton fichier exemple
Voir ce que cela donne avec un fichier avec

"plusieurs centaines de colonnes"

Sub testOK()
Dim fSrc As Worksheet, tmpS As Worksheet
Dim new_name$, i&, nb_filtre%
Set fSrc = ThisWorkbook.Sheets("Feuil1")
Tb_c = fSrc.Cells(1, fSrc.Columns.Count).End(xlToLeft).Column


nb_filtre = InputBox("Entrer la valeur seuil", "Filtre petites tailles")
Dir_save = ThisWorkbook.Path & "\"
Application.DefaultSaveFormat = xlWorkbookDefault
Application.ScreenUpdating = False
For i = 1 To Tb_c
    new_name = "Filtre_" & i & "_" & nb_filtre
    Sheets.Add.Name = new_name
    Set tmpS = Sheets(new_name)
    tmpS.[A1] = fSrc.Cells(1, i)
    tmpS.[A2] = ">" & nb_filtre
    fSrc.Columns(i).AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=tmpS.Range("A1:A2"), CopyToRange:=tmpS.Range("B1"), Unique:=False
    tmpS.Columns(1).Delete
    tmpS.Move
    ActiveWorkbook.SaveAs Dir_save & new_name & ".xlsx"
    ActiveWorkbook.Close True
    Set tmpS = Nothing
Next i
Application.ScreenUpdating = True
End Sub

 

[mdidish]

Re : VBA copier données d'un fichier à un autre

Merci pour ta réponse.
Je mets en fin de message la manière dont j'ai adapté ton code (je voulais un seul fichier final et non un fichier par personne), ça marche, merci beaucoup.

En revanche sais-tu pourquoi la ligne ci-dessous ne marchait pas dans mon code initial ?
Workbooks("exemple.xlsm").Sheets(1).Range(Cells(1, i), Cells(1, i).End(xlDown)).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Filtre_80.xlsx").Sheets(1).Cells(1, i).

En tout cas merci.

Sub filtre()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim fSrc As Worksheet, tmpS As Worksheet
Dim new_name$, i&, nb_filtre%

Set fSrc = ThisWorkbook.Sheets("Feuil1")
Tb_c = fSrc.Cells(1, fSrc.Columns.Count).End(xlToLeft).Column
nb_filtre = InputBox("Entrer la valeur seuil", "Filtre petites tailles")
new_name = "Filtre_" & nb_filtre
Sheets.Add.Name = new_name
Set tmpS = Sheets(new_name)

For i = 1 To Tb_c
    Tb_c_temp = tmpS.Cells(1, fSrc.Columns.Count).End(xlToLeft).Column + 1
    tmpS.Cells(1, Tb_c_temp) = fSrc.Cells(1, i)
    tmpS.Cells(2, Tb_c_temp) = ">" & nb_filtre
    fSrc.Columns(i).AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=tmpS.Range(Cells(1, Tb_c_temp), Cells(2, Tb_c_temp)), CopyToRange:=tmpS.Cells(1, Tb_c_temp + 1), Unique:=False
    tmpS.Columns(Tb_c_temp).Delete
Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Staple1600]

Re : VBA copier données d'un fichier à un autre

Re

mdidish
Personnellement j'aurai écris (comme tu l'as pu voir dans mon code* de mon précédent message)
(sauf que j'éviterai l'emploi de xlDown, potentiellement problématique , si présence de cellules vides)

Workbooks("exemple.xlsm").Sheets(1).Range(Cells(1, i), Sheets(1).Cells(1, i).End(xlDown))SpecialCells(xlCellTypeVisible).Copy

*: Tb_c = fSrc.Cells(1, fSrc.Columns.Count).End(xlToLeft).Column

 

[mdidish]

Re : VBA copier données d'un fichier à un autre

Workbooks("exemple.xlsm").Sheets(1).Range(Cells(1, i), Sheets(1).Cells(1, i).End(xlDown))SpecialCells(xlCellTypeVisible).Copy

Toujours la même erreur.

Pour le moment je garde le code que tu m'as proposé. Si quelqu'un peut m'expliquer pourquoi mon code initial ne marche pas, je suis preneur.

 

[Staple1600]

Re : VBA copier données d'un fichier à un autre

Re


Si tu préfères le filtre automatique, voici ma syntaxe avec l'Autofilter
Je te laisse ajouter/modifier ce qui concerne l'enregistrement du *.xlsx
(test OK sur mon PC)

Sub z()
Dim fSrc As Worksheet, tmpSh As Worksheet
Dim new_name$, nb_filtre, Tb_c&, i&
nb_filtre = InputBox("Entrer la valeur seuil", "Filtre petites tailles")
Set fSrc = ThisWorkbook.Sheets("Feuil1")
Tb_c = fSrc.Cells(1, fSrc.Columns.Count).End(xlToLeft).Column
new_name = "Filtre_" & nb_filtre
Sheets.Add.Name = new_name
Set tmpSh = Worksheets(new_name)
Application.ScreenUpdating = False
For i = 1 To Tb_c
    fSrc.Activate
    fSrc.Range(Cells(1, i), fSrc.Cells(Rows.Count, i).End(3)).AutoFilter 1, ">" & nb_filtre
    Range("_FilterDataBase").SpecialCells(xlCellTypeVisible).Copy Destination:=tmpSh.Cells(1, i)
    fSrc.AutoFilterMode = False
Next i
End Sub

 

[mdidish]

Re : VBA copier données d'un fichier à un autre

Merci beaucoup pour cette proposition que je trouve très élégante, j'ai appris :
- qu'en VBA on pouvait appliquer un filtre uniquement sur une colonne,
- et la récupérer par le range "_FilterDataBase".

Si tu pouvais en plus m'expliquer ce que Excel ne comprends pas dans :
Workbooks("exemple.xlsm").Sheets(1).Range(Cells(1, i), Cells(1, i).End(xlDown)).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Workbooks("Filtre_80.xlsx").Sheets(1).Cells(1, i).

... ce serait parfait ! (au vu de ta proposition je ne me servirais plus de cette ligne de code, mais j'aimerais comprendre la logique d'Excel)

 

[Staple1600]

Re : [Résolu] VBA copier données d'un fichier à un autre

Re

middish
Je t'ai déjà expliqué le pourquoi dans le message de 18h35
(Il faut identifier le nom de la feuille partout dans Range(cells(x,y),cells(x,))
d'où les mots en gras dans le message #4)

NB: Je viens de tester et les syntaxes fonctionnent
(mais encore une fois xlDown peut jouer des tours)
Code VBA:
'ma syntaxe
'Range("_FilterDataBase").SpecialCells(xlCellTypeVisible).Copy Destination:=tmpSh.Cells(1, i)
'ci-dessous l'équivalent modifié et qui marche de ta syntaxe
fSrc.Range(Cells(1, i), fSrc.Cells(1, i).End(xlDown)).SpecialCells(xlCellTypeVisible).Copy Destination:=tmpSh.Cells(1, i)

 

[mdidish]

Re : [Résolu] VBA copier données d'un fichier à un autre

ok, je n'avais par rajouté le nom de la feuille avant le premier Cells du Range ; effectivement ça marche.
Je garde finalement la solution du #6.
Merci encore