Modifier plusieurs fichiers excel(2010) au sein d'un unique répertoire via Macro

DDD

XLDnaute Nouveau
Bonjour !
Ayant cherché un sujet similaire sur plusieurs forums, j'ai pu avancer quelque peu sur un blocage que je rencontre actuellement.
Voici les différentes démarches pour exemple :
1 - chaque semaine, je vais dans une base de données pour extraire différents fichiers excel (exemple de fichier en PJ : "fichier X" onglet : Liste extraction)
2 - Ces fichiers sont ensuite sauvegardés dans un répertoire (ex : appelé C:\toto)
3 - Je les retravaille manuellement afin de : supprimer les lignes 1 à 12, supprimer les colonnes D à G, et supprimer la case "merci" et signature de Mr. X" afin d'avoir le fichier en onglet " liste souhaitée"

Après plusieurs recherches, je dispose d'un fichier excel dans lequel j'ai introduis une macro (en PJ "classeur 1") afin d'aller automatiquement dans le répertoire susnommé (toto), ouvrir l'ensemble des fichiers excel étant à l'intérieur, afin que sur chaque fichier, soit effectuées les différentes opérations mentionnées au point 3.).

Le répertoire est bien identifié (lorsque je mets le vrai nom de répertoire), la macro va ouvrir les fichiers, les sauvegarde, et les ferme, comme souhaité. Alors que je pensais ajouter un simple code : "pour cellule C de chaque ligne, si cellule C est vide, supprimer la ligne" et supprimer les colonnes D à G ; impossible de rajouter les opérations que je souhaite effectuer en plus, dans le code présent.. qui ne les prend pas en complete..

Si l'un d'entre vous saurait m'aiguiller... Je suis preneur !
 

Pièces jointes

  • Classeur1.xls
    36 KB · Affichages: 10
  • Fichier X .xls
    10 KB · Affichages: 12

Staple1600

XLDnaute Barbatruc
Bonsoir

Je te laisse faire les tests et adaptions en te basant sur l'exemple et mes commentaires
VB:
Private Sub CommandButton4_Click()
'Déclaration des variables
Dim myPath As String, myFile As String
 
'Ici, je place mon répertoire
myPath = "C:\toto"
 
'Permet de récupérer le nom des fichiers du répertoire
myFile = Dir(myPath & "\*.*")
 
'Boucle sur l'ensemble des fichiers du répertoire
Do While myFile <> ""
    'On appelle la fonction "ClasseurOuvert" définie plus bas : elle permet de vérifier si le classeur est ouvert du répertoire. Sinon, cette fonction ouvre le classeur.
    Call ClasseurOuvert(myPath & "\" & myFile)
 
    'Avec le classeur ouvert ou qu'on vient d'ouvrir...
    With Workbooks(myFile)
    'juste pour test
    MsgBox .FullName
   MsgBox .Sheets(1).Range("C1:C10").Address
 'intégrer mes commandes : ce que je n'arrive pas à faire !!!
 'donc normalement il faudrait écrire tes commandes en identifiant au préalable la feuille concernée
 'et la plage de cellules concernée
 '.Sheets(1).Range(...
    ActiveWorkbook.Save    'enregistrer les modifications
    ActiveWorkbook.Close  'Fermer
    End With
    'Et on passe au suivant
    myFile = Dir()
Loop
End Sub
 

DDD

XLDnaute Nouveau
Bonsoir

Je te laisse faire les tests et adaptions en te basant sur l'exemple et mes commentaires
VB:
Private Sub CommandButton4_Click()
'Déclaration des variables
Dim myPath As String, myFile As String

'Ici, je place mon répertoire
myPath = "C:\toto"

'Permet de récupérer le nom des fichiers du répertoire
myFile = Dir(myPath & "\*.*")

'Boucle sur l'ensemble des fichiers du répertoire
Do While myFile <> ""
    'On appelle la fonction "ClasseurOuvert" définie plus bas : elle permet de vérifier si le classeur est ouvert du répertoire. Sinon, cette fonction ouvre le classeur.
    Call ClasseurOuvert(myPath & "\" & myFile)

    'Avec le classeur ouvert ou qu'on vient d'ouvrir...
    With Workbooks(myFile)
    'juste pour test
    MsgBox .FullName
   MsgBox .Sheets(1).Range("C1:C10").Address
'intégrer mes commandes : ce que je n'arrive pas à faire !!!
'donc normalement il faudrait écrire tes commandes en identifiant au préalable la feuille concernée
'et la plage de cellules concernée
'.Sheets(1).Range(...
    ActiveWorkbook.Save    'enregistrer les modifications
    ActiveWorkbook.Close  'Fermer
    End With
    'Et on passe au suivant
    myFile = Dir()
Loop
End Sub

Bonsoir ! Cela fonctionne et me fait bien apparaître une fenêtre (msgbox) avec C1C10.
Le problème viendrait donc de l'identification de la feuille concernée ?
 

Staple1600

XLDnaute Barbatruc
Re

Un petit bonus pour continuer à t'aiguiller sur une voie
(ici l'utilisateur choisit le répertoire)
VB:
Sub Test_OK()
Dim FolderName$, MyPath, wkbSource As Workbook
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    On Error Resume Next
    FolderName = .SelectedItems(1)
    Err.Clear
    On Error GoTo 0
End With
MyPath = FolderName
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Boucle sur l'ensemble des fichiers du répertoire
MyFile = Dir(MyPath & "*.xl?")
Application.DisplayAlerts = False
Do While Len(MyFile) > 0
  Set wkbSource = Workbooks.Open(MyPath & MyFile)
  'Avec le classeur ouvert ou qu'on vient d'ouvrir...
  With wkbSource
  On Error Resume Next
  '(suppression des vides en colonne C sur la feuille 1)
       .Sheets(1).Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
       .Close savechanges:=True
  End With
  Set wkbSource = Nothing
  'Et on passe au suivant
  MyFile = Dir()
Loop
End Sub
 

DDD

XLDnaute Nouveau
Re

Un petit bonus pour continuer à t'aiguiller sur une voie
(ici l'utilisateur choisit le répertoire)
VB:
Sub Test_OK()
Dim FolderName$, MyPath, wkbSource As Workbook
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    On Error Resume Next
    FolderName = .SelectedItems(1)
    Err.Clear
    On Error GoTo 0
End With
MyPath = FolderName
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Boucle sur l'ensemble des fichiers du répertoire
MyFile = Dir(MyPath & "*.xl?")
Application.DisplayAlerts = False
Do While Len(MyFile) > 0
  Set wkbSource = Workbooks.Open(MyPath & MyFile)
  'Avec le classeur ouvert ou qu'on vient d'ouvrir...
  With wkbSource
  On Error Resume Next
  '(suppression des vides en colonne C sur la feuille 1)
       .Sheets(1).Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
       .Close savechanges:=True
  End With
  Set wkbSource = Nothing
  'Et on passe au suivant
  MyFile = Dir()
Loop
End Sub

En effet, c'est encore mieux et me permet d'appliquer la macro dès lors que je créé un nouveau répertoire...
J'ai simplement ajouté la ligne suite après celle ci :
.Sheets(1).Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.Sheets(1).Columns("D:G").Delete Shift:=xlToLeft
afin de supprimer les colonnes D à G, cela semble fonctionner.
Concernant "merci" ainsi que "signature" il s'agit simplement de sélectionner les cellules contenant ce mot et les supprimer, cela ne me semble pas très compliqué. Par contre, il ne me resterai qu'une petite modification... si je n'abuse pas.. C'est que dans chaque fichier, deux lignes au dessus de la cellule "merci" (colonne A Donc), il faudrait que j'ajoute le mot 'Total', car ma dernière ligne d'extraction reprend le total des calculs (anonymisés).

J'avais déjà utilisé certaines formules avec cell.Value et offset(0.1) ou autre pour me déplacer par rapport à une cellule fixe, mais j'avoue ne pas maîtriser la chose.

Dans tous les cas, merci beaucoup pour ce partage de connaissance !
 

Staple1600

XLDnaute Barbatruc
Re

Concernant "merci" ainsi que "signature" il s'agit simplement de sélectionner les cellules contenant ce mot et les supprimer, cela ne me semble pas très compliqué.
Tu veux effacer le contenu des cellules ou supprimer les cellules (donc les lignes où elles se trouvent) ?

PS: Impossible d'ouvrir ton fichier: Fichier X.xls
 

DDD

XLDnaute Nouveau
Je souhaites supprimer les cellules (et donc les lignes qui y sont rattachées en effet)
ps : je viens de voir en effet qu'il ne fonctionnait pas sur le précédent traitement, je le rechargerai demain de mon ordinateur si besoin est, mais les regles restent identiques dans tous les cas.
 

DDD

XLDnaute Nouveau
Bonjour Staple,
Grâce à ton code j'ai pu modifier "presque" comme souhaité mon fichier, seulement, à chaque exécution de la macro, cela me créé un second dossier dans le répertoire cible, composé de 4 éléments (filelist.xml / sheet001.htm / stylesshee.css et tabstrip.htm)
Est ce normal ?
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, DDD

Est-ce normal?
Qu'est-ce qui normal en ce vaste monde, hein ? ;)

Mais recentrons nous sur la macro et en premier lieu ton ton dossier.
Quel type de fichiers contient ce dossier?
Uniquement des classeurs Excel (avec les extensions suivantes: xls ou xlsx ou xlsm ou xlsb) ?
 

DDD

XLDnaute Nouveau
Bonsoir le fil, DDD

Est-ce normal?
Qu'est-ce qui normal en ce vaste monde, hein ? ;)

Mais recentrons nous sur la macro et en premier lieu ton ton dossier.
Quel type de fichiers contient ce dossier?
Uniquement des classeurs Excel (avec les extensions suivantes: xls ou xlsx ou xlsm ou xlsb) ?
Ce n'est pas à moi de me prononcer sur cette vaste question :)

Concernant mon mon dossier, il ne s'agit uniquement que de "xls". A force de parcourir quelques indicateurs, j'ai pu trouver cette formule :
Code:
Sub ConvertToCSV()

Dim myPath As String

Dim myString As Variant

    Application.DisplayAlerts = False

'Open Workbook

    With Application.FileDialog(msoFileDialogOpen)



        .AllowMultiSelect = False

        .Show

        myPath = .SelectedItems(1)

    End With

'Open Workbook

    Workbooks.Open Filename:=myPath

'Remove Excel Extension from String

    myExtension = "." & CreateObject("Scripting.FileSystemObject").GetExtensionName(myPath)

    myPath = Left(myPath, Len(myPath) - Len(myExtension))

'Save as CVS

    ActiveWorkbook.SaveAs Filename:=myPath & ".csv", FileFormat:=xlCSV, CreateBackup:=False, Local:=True


'Close Window

    ActiveWindow.Close

'Turn on Alerts

    Application.DisplayAlerts = True


End Sub
[/CODE]

Cette macro fonctionne sur un dossier lamba ne contenant aucune autre consigne, mais je n'arrive pas à "l'incorporer" dans ce que tu m'avais transmis..
 

Staple1600

XLDnaute Barbatruc
Re

1 - chaque semaine, je vais dans une base de données pour extraire différents fichiers excel(exemple de fichier en PJ : "fichier X" onglet : Liste extraction)
Un fichier CSV ce n'est pas à proprement parler un fichier Excel ;)

Tu veux ouvrir tes fichier Excel pour les convertir en *.csv?

Dans ce cas, on s'éloigne de :
3 - Je les retravaille manuellement afin de : supprimer les lignes 1 à 12, supprimer les colonnes D à G, et supprimer la case "merci" et signature de Mr. X" afin d'avoir le fichier en onglet " liste souhaitée"
 

DDD

XLDnaute Nouveau
Re


Un fichier CSV ce n'est pas à proprement parler un fichier Excel ;)
C'est à dire ?

Tu veux ouvrir tes fichier Excel pour les convertir en *.csv?
Dans ce cas, on s'éloigne de :

Alors pas exactement !
En fait, je "souhaiterai" dans la mesure du possible :
- réaliser l'ensemble des opérations mentionnées (ligne 1 à 12, remplacer . par 0, colonnes D à G, etc, et
- et en sauvegardant mon fichier (et passer au suivant), le "convertir" en CSV
 

DDD

XLDnaute Nouveau
Ps : Mais je pourrais très bien aussi effectuer toutes les opérations que je souhaite, sauvegarder en xls, et créer un second bouton de commande, avec la macro que j'ai mentionné précédemment.. Le problème est qu'elle fonctionne par choix de fichier, et non de dossier/répertoire, comme celle que tu m'a proposé. Et c'est là où je n'arrive plus à l'incorporer... (j'espère ne pas me perdre dans mes explications)
 

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 774
Membres
101 816
dernier inscrit
Jfrcs