Diviser le fichier en plusieurs fichiers dans Excel

J'ai le fichier suivant dans Excel:

NAME VALUE
ABC 10
ABC 11
ABC 12
DEF 20
DEF 21
DEF 22
GHI 30
GHI 31
GHI 32

Je tiens à le diviser en fichiers par le Nom de la colonne (3 fichiers pour l'exemple ci-dessus) de la manière suivante:

Fichier: ABC.xsl

NAME VALUE
ABC 10
ABC 11
ABC 12

Fichier: DEF.xsl

NAME VALUE
DEF 20
DEF 21
DEF 22

Fichier: GHI.xsl

NAME VALUE
GHI 30
GHI 31
GHI 32

Jusqu'à présent, essayé la macro suivante:
https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/parse-functions/sheet1-to-wbs

Eu des erreurs d'exécution sur cette ligne ws.Range(vTitles).AutoFilter
Et après en commentant l'erreur déménagé à ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm) quand vCol's la valeur est devenue vide.

Ce que je fais mal s'il vous plaît? (comme VBA n'est pas mon point fort de l'atm). Tout conseiller en ce qui concerne l'extrait ci-dessus ou un autre code qui fonctionne serait une solution viable pour moi.

  • La meilleure façon de "faire" serait d'écrire une macro qui le fait pour vous 😉
  • Si oui, serait-il légitime de se poser la question pour l'un, s'il vous plaît?
  • Aussi, j'aimerais demander au sujet de la raison pour un downvote.
  • Il ne serait pas une question légitime de nous demander d'écrire une macro pour vous. Voir comment demander et comment poser une bonne question.
  • merci pour l'entrée. ok déplacé sur et élaboré de la manière que j'ai traversé jusqu'à présent, il est mieux maintenant, s'il vous plaît?
  • pas vraiment, maintenant, c'est de devenir un dépannage de chat qui n'est pas ce qui DONC est. Vous avez besoin de comprendre le code que vous utilisez. Utiliser google
  • laissez-nous continuer cette discussion dans le chat
  • Désolé je n'ai pas eu le temps supplémentaire pour vous aider avec ce...
  • Hey @BreakPhreak, a fait le code ci-dessous fonctionne?
  • désolé pour le retard, essayé seulement maintenant! sérieusement, j'aimerais vous acheter une bière pour cette, puis-je?

InformationsquelleAutor BreakPhreak | 2014-04-16
  1. 2

    Je pense que cela devrait vous rendre où vous allez. Le code ci-dessous enregistre chaque groupe comme un classeur (.format xls) dans le même répertoire que le classeur qui abrite le VBA (c'est à dire ThisWorkbook):

    Option Explicit
Sub SplitIntoSeperateFiles()
Dim OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim FilterRange As Range
Dim UniqueNames As New Collection
Dim LastRow As Long, LastCol As Long, _
NameCol As Long, Index As Long
Dim OutName As String
'set references and variables up-front for ease-of-use
Set DataSheet = ThisWorkbook.Worksheets("Sheet1")
NameCol = 1
LastRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set FilterRange = Range(DataSheet.Cells(1, NameCol), DataSheet.Cells(LastRow, LastCol))
'loop through the name column and store unique names in a collection
For Index = 2 To LastRow
On Error Resume Next
UniqueNames.Add Item:=DataSheet.Cells(Index, NameCol), Key:=DataSheet.Cells(Index, NameCol)
On Error GoTo 0
Next Index
'iterate through the unique names collection, writing 
'to new workbooks and saving as the group name .xls
Application.DisplayAlerts = False
For Index = 1 To UniqueNames.Count
Set OutBook = Workbooks.Add
Set OutSheet = OutBook.Sheets(1)
With FilterRange
.AutoFilter Field:=NameCol, Criteria1:=UniqueNames(Index)
.SpecialCells(xlCellTypeVisible).Copy OutSheet.Range("A1")
End With
OutName = ThisWorkbook.FullName
OutName = Left(OutName, InStrRev(OutName, "\"))
OutName = OutName & UniqueNames(Index)
OutBook.SaveAs Filename:=OutName, FileFormat:=xlExcel8
OutBook.Close SaveChanges:=False
Call ClearAllFilters(DataSheet)
Next Index
Application.DisplayAlerts = True
End Sub
'safely clear all the filters on data sheet
Sub ClearAllFilters(TargetSheet As Worksheet)
With TargetSheet
TargetSheet.AutoFilterMode = False
If .FilterMode Then
.ShowAllData
End If
End With
End Sub
    • Que l'un comme par magie travaillé hors de la boîte!
    • Content d'avoir pu aider 🙂
    • J'ai une question ultérieure sur comment faire pour que la macro réutilisable: stackoverflow.com/questions/23135211/..., juste pour info / suivi.
    • La macro fonctionnait très bien sur Mac, sur Windows DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious) retourne nothing (d'où l'erreur d'exécution). Des conseils s'il vous plaît?
    • Hmm... très intéressant. Est-il possible que DataSheet est vide? En regardant le code ci-dessus, DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row devraient retourner un Long, pas un Range (et Nothing est renvoyée lorsqu'une Range est raté)
    • Le DataSheet n'est pas vide, de plus la ligne suivante renvoie une valeur non vide: DataSheet.Range("A65536").End(xlUp).Row - mais il serait erroné de supposer la limite de ligne.
    • Très intéressant en effet. Je pense que le code que j'ai utilisé ci-dessus est en conformité avec les meilleures pratiques pour l'identification des derniers rangs comme expliqué ici: stackoverflow.com/questions/11169445/...
    • Viens de publier ma réponse (qui ne sont pas marqués, bien sûr) avec le code qui a fonctionné sur Windows. Il ne fonctionne pas sur Mac, mais pour mon cas c'est assez bon 🙂

    InformationsquelleAutor Dan Wagner
  2. 1

    Juste pour le record, ce code a fonctionné pour moi sur Windows (mais pour une raison pas sur Mac):

    Option Explicit
Sub SplitIntoSeparateFiles()
Dim OutBook, MyWorkbook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim FilterRange As Range
Dim UniqueNames As New Collection
Dim LastRow As Long, LastCol As Long, _
NameCol As Long, Index As Long
Dim OutName As String
'set references and variables up-front for ease-of-use
'the current workbook is the one with the primary data, more workbooks will be created later
Set MyWorkbook = ActiveWorkbook 
Set DataSheet = ActiveSheet 'was ThisWorkbook.Worksheets("Sheet1"), now works for every sheet
NameCol = 1
LastRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'LastRow = DataSheet.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
LastCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set FilterRange = Range(DataSheet.Cells(1, NameCol), DataSheet.Cells(LastRow, LastCol))
'loop through the name column and store unique names in a collection
For Index = 2 To LastRow
On Error Resume Next
UniqueNames.Add Item:=DataSheet.Cells(Index, NameCol), Key:=DataSheet.Cells(Index, NameCol)
On Error GoTo 0
Next Index
'iterate through the unique names collection, writing
'to new workbooks and saving as the group name .xls
Application.DisplayAlerts = False
For Index = 1 To UniqueNames.Count
Set OutBook = Workbooks.Add
Set OutSheet = OutBook.Sheets(1)
With FilterRange
.AutoFilter Field:=NameCol, Criteria1:=UniqueNames(Index)
.SpecialCells(xlCellTypeVisible).Copy OutSheet.Range("A1")
End With
OutName = MyWorkbook.Path + "\" 'was OutName = Left(OutName, InStrRev(OutName, "\"))
'the question here would be to modify the separator for every platform
OutName = OutName & UniqueNames(Index)
OutBook.SaveAs Filename:=OutName, FileFormat:=xlExcel8
OutBook.Close SaveChanges:=False
Call ClearAllFilters(DataSheet)
Next Index
Application.DisplayAlerts = True
End Sub
'safely clear all the filters on data sheet
Sub ClearAllFilters(TargetSheet As Worksheet)
With TargetSheet
TargetSheet.AutoFilterMode = False
If .FilterMode Then
.ShowAllData
End If
End With
End Sub
    InformationsquelleAutor BreakPhreak