Copier les données d'une feuille Excel vers différents fichiers

Question

J'ai une feuille Excel qui contient des données volumineuses. Les données sont organisées comme suit, Un ensemble de 7 colonnes et n lignes ; comme dans un tableau, et des milliers de ces tableaux sont placés horizontalement avec une colonne vide pour les séparer. Une capture d'écran est ci-dessous..

...

Je veux simplement que les données de chaque table soient enregistrées dans un fichier différent. Manuellement, cela prendrait des heures ! Alors, existe-t-il une macro ou quelque chose qui me permette d'automatiser cette tâche ? Je ne suis pas très versé dans l'écriture de macros ou de trucs VBA.

Merci,

Answer 1

Tony a raison quand il dit

Si le tableau qui commence à C1 se termine à la ligne 21, le tableau suivant commence-t-il à C23 ? Si le tableau commençant par K1 se termine à la ligne 15, le tableau suivant commence-t-il par K17 ou K23 ?

Voici donc un code qui fonctionnera dans toutes les conditions, c'est-à-dire que les données sont placées horizontalement ou verticalement.

APERÇU DES DONNÉES

CODE

'~~> Change this to the relevant Output folder
Const FilePath As String = "C:\Temp\"

Dim FileNumb As Long

Sub Sample()
    Dim Rng As Range
    Dim AddrToCopy() As String
    Dim i As Long

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlTextValues)

    If Not Rng Is Nothing Then
        AddrToCopy = Split(Rng.Address, ",")

        FileNumb = 1

        For i = LBound(AddrToCopy) To UBound(AddrToCopy)
            ExportToSheet (AddrToCopy(i))
        Next i
    End If

    MsgBox "Export Done Successfully"

LetsContinue:
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Sub ExportToSheet(rngAddr As String)
    Range(rngAddr).Copy

    Workbooks.Add
    ActiveSheet.Paste

    ActiveWorkbook.SaveAs Filename:= _
    FilePath & "Output" & FileNumb & ".csv" _
    , FileFormat:=xlCSV, CreateBackup:=False

    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True

    FileNumb = FileNumb + 1
End Sub

NOTA : Le code ci-dessus fonctionnera pour les cellules avec seulement Valeurs du texte . Pour les cellules avec seulement Valeurs numériques vous devez utiliser

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)

Et pour Valeurs alpha-numériques (comme dans votre question ci-dessus), utilisez ceci

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)

HTH

Sid

Answer 2

Tant qu'une ligne et une colonne vides entourent les ensembles de données, la méthode AREAS() est utilisée pour les placer dans des classeurs séparés.

Comme dans l'exemple précédent, il est enregistré au format CSV, mais vous pouvez bien sûr l'enregistrer comme vous le souhaitez.

Option Explicit

Sub ExportDataGroups()
Dim fPATH As String, Grp As Long, DataRNG As Range

fPATH = "C:\Path\Where\I\Want\My\Files\Saved\"    'remember the final \
Application.ScreenUpdating = False

Set DataRNG = ActiveSheet.UsedRange

    For Grp = 1 To DataRNG.Areas.Count
        DataRNG.Areas(Grp).Copy
        Sheets.Add
        Range("A1").PasteSpecial
        ActiveSheet.Move

        ActiveWorkbook.SaveAs Filename:=fPATH & "-" & Format(Grp, "0000") & ".csv", _
            FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close
    Next Grp

MsgBox "A total of " & Grp & " files were created"
Application.ScreenUpdating = True

End Sub

Answer 3

Dans votre réponse à mon commentaire, vous déclarez : "Nom de fichier, je n'y ai jamais pensé. Ça peut être n'importe quoi pour le moment." Par expérience amère, je peux vous dire que traiter des milliers de fichiers avec des noms générés par le système est un cauchemar. Vous devez régler le problème du nom maintenant.

Je suis aussi nerveux à propos AddrToCopy = Split(Rng.Address, ",") . Rng.Address sera de la forme : "$C$1:$I$16, $K$1:$Q$16, $S$1:$Y$16, $C18$I$33, $K$18:$Q$33, $S$18:$Y$33, ...". Si vous cherchez sur Internet, vous trouverez des sites qui vous diront que Rng.Address a une longueur maximale de 253 caractères. Je ne pense pas que cela soit correct. D'après mon expérience, Rng.Address est tronquée à une sous-gamme complète. J'ai expérimenté avec Excel 2003, mais j'ai trouvé sur Internet des informations suggérant que cette limitation a été corrigée dans les versions ultérieures d'Excel. Vous pouvez vérifier Rng.Address avec votre version d'Excel ! Je ne connais pas Jerry Beaucaire, mais il propose une solution intéressante. Sid Rout produit toujours un excellent code. S'il y a un problème, je suis sûr qu'il saura le résoudre.

Cependant, le but réel de cette "réponse" est de dire que je diviserais ce problème en trois. Cette solution présente de nombreux avantages et aucun inconvénient à ma connaissance.

Étape 1. Créez une nouvelle feuille de calcul, TableSpec avec les colonnes suivantes :

A      Worksheet name. (If tables are spread over more than worksheet) 
B      Range. For example: C1:I16, K1:Q16
C - I  Headings from table. For example, AAPL, Open, High, Low, Close, Volume, AdjClose 

Étape 2. Vérifiez la feuille de travail TableSpec Par exemple, toutes les tables sont-elles répertoriées ? Pensez au nom du fichier et ajoutez la colonne H pour le contenir. J'ai lu un de vos commentaires comme signifiant que vous vouliez "AAPL" comme nom de fichier pour la première table, auquel cas vous pourriez définir H2 sur "=C2". Est-ce que "AAPL" est unique ? Vous pourriez avoir un numéro de séquence. Il existe de nombreux choix auxquels vous pouvez réfléchir avant de générer des fichiers.

Étape 3. Feuille de travail TableSpec donne maintenant toutes les informations nécessaires pour générer vos fichiers. Vous pouvez supprimer la plupart des contenus et tester le code de création de fichiers sur quelques lignes.

J'espère que vous pouvez voir les avantages de cette approche progressive, en particulier si votre VBA est faible. Bonne chance.