Ça ne va pas arriver souvent, vu que je prône l'utilisation de logiciels libres, mais voici un script VBA pour Excel que j'ai du faire au boulot.
La tâche : j'ai une feuille contenant un tas de rapport de ventes, les uns à la suite des autres, séparés par une ligne vide à chaque fois.
Il fallait splitter chaque rapport dans une nouvelle feuille.
Vu que j'ai du écrire 3 lignes de VBA dans ma vie, il y a plus de 15 ans, j'étais passablement rouillé.
Tellement rouillé qu'en fait j'ai juste été pomper des bouts de codes à droite à gauche pour les mélanger ensemble et espérer que ça marche.
Et ça marche !
Par contre pour le style, on repassera. J'ai tenté de nettoyer le code après coup mais il reste probablement des horreurs qui feront bondir les puristes.
Fichier source
Résultat final
Algorithme en 2 mots
Je duplique la feuille de base, je cherche la 1ère ligne vide, je copie la plage jusqu'à la ligne vide dans une nouvelle feuille au nom du client, je supprime la plage sélectionnée et je recommence.
A la fin je supprime la feuille dupliquée.
Code source
Sub split()
Dim firstPage As Worksheet
Set firstPage = Sheets(1) ' La page de référence, à parser et spliter
' https://msdn.microsoft.com/en-us/library/office/ff837784.aspx
firstPage.Copy After:=firstPage ' On copie la page de base
Dim copyPage As Worksheet
Set copyPage = Sheets(2) ' La page copiée, qu'on peut modifier
copyPage.Name = "temp"
Dim nextBlankRow As Long
nextBlankRow = firstBlankRow(copyPage)
While (nextBlankRow > 0)
Dim clientName As String
clientName = findClientName(copyPage.Range("A:A"))
Sheets.Add After:=Sheets(Sheets.Count) ' crée une nouvelle feuille et l'ajoute à la fin du classeur
Dim newPage As Worksheet
Set newPage = Sheets(Sheets.Count) ' On récupère la feuille nouvellement créée
newPage.Name = clientName ' renome la nouvelle feuille
Dim nbCol As Long
nbCol = copyPage.UsedRange.Columns.Count
Dim currentRange As Range
Set currentRange = copyPage.Range("A1", copyPage.Cells(nextBlankRow, nbCol))
' http://stackoverflow.com/questions/21648122/excel-vba-copy-range-and-paste-values-in-another-sheets-specific-range
currentRange.Copy ' Copie des valeurs de la 1ère page
newPage.Range("A1").PasteSpecial xlPasteValues ' on colle dans la nouvelle feuille
newPage.Columns.AutoFit ' ajuster la taille des colones : http://www.extendoffice.com/documents/excel/1174-excel-split-data-into-multiple-worksheets-based-on-column.html
newPage.Range("A1").Select ' lâche la sélection
currentRange.Delete ' Supprime la plage pour pouvoir recommencer avec la suivante
nextBlankRow = firstBlankRow(copyPage)
Wend
Application.DisplayAlerts = False
copyPage.Delete
Application.DisplayAlerts = True
firstPage.Select
firstPage.Range("A1").Select
End Sub
Function findClientName(fullCol As Range) As String
For Each cell In fullCol.Cells
If cell.Value <> "" Then
findClientName = cell.Value
Exit For
End If
Next
End Function
Function firstBlankRow(ws As Worksheet) As Long
'returns the row # of the row after the last used row
'Or the first row with no data in it
'http://stackoverflow.com/questions/12497804/finding-first-blank-row-then-writing-to-it
Dim rngSearch As Range, cel As Range
With ws
Set rngSearch = .UsedRange.Columns(1).Find("") '-> does blank exist in the first column of usedRange
If Not rngSearch Is Nothing Then
Set rngSearch = .UsedRange.Columns(1).SpecialCells(xlCellTypeBlanks)
For Each cel In rngSearch
If Application.WorksheetFunction.CountA(cel.EntireRow) = 0 Then
firstBlankRow = cel.Row
Exit For
End If
Next
Else '-> no blanks in first column of used range
If Application.WorksheetFunction.CountA(Cells(.Rows.Count, 1).EntireRow) = 0 Then '-> is the last row of the sheet blank?
'-> yeap!, then no blank rows!
firstBlankRow = -1
'MsgBox "Whoa! All rows in sheet are used. No blank rows exist!"
Else
'-> okay, blank row exists
firstBlankRow = .UsedRange.SpecialCells(xlCellTypeBlanks).Row + 1
End If
End If
End With
End Function
Le fichier qui contient tout
Fichier
Créer une macro VBA
Menu Outils, Macro, Visual Basic Editor
Lancer une macro VBA
Menu Outils, Macro, Macros, sélectionner Feuil1.split (nom de la feuille original + nom de la méthode Sub)
Notez que, par défaut, si vous ouvrez un fichier avec une macro le programme vous avertira des problèmes de sécurité et les désactivera.
Pour les autoriser, rendez-vous dans le menu Outils, Options, onglet Sécurité, bouton Sécurité des macros et sélectionnez Moyen ou Faible.
Sources
Copier une plage de valeurs
Trouver la prochaine ligne vide
Ajuster la taille des colones
Dupliquer une feuille
Versions
Microsoft Excel 2002 (10.2614.2625)
Microsoft Visual Basic 6.3
