Fusion chiffriers et onglets

[larivs]

J'ai 27 chiffriers Excel à fusionner dans un seul chiffrier. Chaque chiffrier contient 24 onglets.
Je désire fusionner 4 onglets de ces 27 fichiers dans 4 onglets d'un nouveau chiffrier. (à la limite, je pourrais fusionner les 24 onglets)
Les données de ces onglets débutent à la ligne x (pareil pour chaque onglet du même nom, mais différent pour un autre onglet).
Les onglets n'ont pas tous le même nombre de ligne (même ceux qui ont le même nom). Tous les onglets du même nom ont le même nombre et nom de colonnes.

Ce que je cherche: une macro (ou un outil) capable de lire mes 4 onglets des 27 chiffriers et de créer dans un nouveau chiffrier les 4 onglets que je désire fusionner. Elles devraient lire de la ligne x (variable pour chaque onglet) jusqu'à la première ligne vide de l'onglet.

Je ne peux pas fournir un exemple de chiffrier (même vide) car les chiffriers et les données sont confidentiels.

J'ai déjà consulté et essayé certaines solutions offertes sur le forum. Aucune ne fait exactement ce que je désire.

Merci.

 

[PMO2]

Re : Fusion chiffriers et onglets

Bonjour,

Pouvez vous spécifier les points suivants

1) Les noms des 4 onglets à fusionner et confirmer s'il portent bien, respectivement, le même nom dans les 27 classeurs
2) Le numéro de la ligne de départ x de chacun de ces 4 onglets (ex : nom_onglet1 lig 27, nom_onglet2 lig 38...)
3) Préciser, pour ces 4 onglets, la colonne sur laquelle on peut se baser pour y extraire toutes les données (la colonne dont la dernière ligne renseignée est la dernière ligne des données )

Cordialement.

PMO
Patrick Morange

 

[larivs]

Re : Fusion chiffriers et onglets

Bonjour et merci de votre attention Patrick.

En réponse à vos questions:

1. Les 4 onglets portent les noms suivants:

1.Inventaire -------> le "1." fait partie du nom
2.Vulnérabilité -------> le "2." fait partie du nom
Sommaire
Detail -------> il n'y a pas d'accent sur le "e"

2. Ligne de départ de "1.Inventaire" = 9
Ligne de départ de "2.Vulnérabilité" = 10
Ligne de départ de "Sommaire" = 7
Ligne de départ de "Detail" = 2

3. Colonne sur lesquelles on doit vérifier la fin des données pour chaque onglets:
"1.Inventaire" colonne A
"2.Vulnérabilité" colonne A
"Sommaire" colonne D
"Detail" colonne A

Encore merci.

 

[PMO2]

Re : Fusion chiffriers et onglets

Bonjour,

Voici une solution avec le code suivant à copier dans un module standard d'un nouveau classeur.

Dim OngletNom
Dim OngletDepart
Dim OngletColonne

Sub Initialise(Optional dummy As Byte)
  '### Noms, lignes de départ des données, colonne/base ###
  '### A adapter selon votre usage                      ###
OngletNom = Array("1.Inventaire", "2.Vulnérabilité", "Sommaire", "Detail")
OngletDepart = Array(9, 10, 7, 2)
OngletColonne = Array(1, 1, 4, 1)
  '########################################################
End Sub

Sub FusionOnglets()
Dim MyShell As Object
Dim MyFolder As Object
Dim Chemin$
Dim i&
Dim j&
Dim cpt&
Dim nbLig&
Dim nbCol&
Dim WBnew As Workbook
Dim WB As Workbook
Dim S As Worksheet
Dim S2 As Worksheet
Dim R As Range
Dim Log$()
Call Initialise
Set MyShell = CreateObject("Shell.Application")
Set MyFolder = MyShell.BrowseForFolder( _
    0, "Choisissez le dossier contenant les classeurs à fusionner", 1)
If MyFolder Is Nothing Then Exit Sub
On Error Resume Next
Chemin$ = MyFolder.ParentFolder.ParseName(MyFolder.Title).Path & ""
If Err = 91 Then
  Chemin$ = Mid(MyFolder.Title, InStr(MyFolder.Title, ":") - 1, 2) & ""
  If Chemin$ = "" Then
    MsgBox "Veuillez choisir un autre dossier que le dossier ''" & MyFolder.Title & "''"
    Exit Sub
  End If
  Err.Clear
End If
With Application.FileSearch
  .LookIn = Chemin$
  .FileType = msoFileTypeExcelWorkbooks
  .Execute
  If .FoundFiles.Count = 0 Then
    MsgBox "Aucun classeur n'a été trouvé dans " & Chemin$
    Exit Sub
  End If
End With
Set WBnew = Workbooks.Add(xlWBATWorksheet)
For i& = 1 To 3
  WBnew.Sheets.Add
Next i&
For i& = 1 To 4
  WBnew.Sheets(i&).Name = OngletNom(i& - 1)
Next i&
Application.ScreenUpdating = False
For i& = 1 To Application.FileSearch.FoundFiles.Count
  Chemin$ = Application.FileSearch.FoundFiles(i&)
  Set WB = GetObject(Chemin$)
  WB.Windows(1).Visible = True
  For j& = LBound(OngletNom) To UBound(OngletNom)
    Set S = Nothing
    Set S = WB.Sheets(OngletNom(j&))
    If S Is Nothing Then
      cpt& = cpt& + 1
      ReDim Preserve Log$(1 To 1, 1 To cpt&)
      Log$(1, cpt&) = "La feuille ''" & OngletNom(j&) & _
          "'' n'existe pas dans " & Chemin$
      Err.Clear
    Else
      S.Activate
      nbLig& = S.Range(S.Cells(65536, OngletColonne(j&)), _
          S.Cells(65536, OngletColonne(j&))).End(xlUp).Row
      nbCol& = S.UsedRange.Columns.Count
      Set R = S.Range(S.Cells(OngletDepart(j&), 1), S.Cells(nbLig&, nbCol&))
      R.Copy
      Set S2 = WBnew.Sheets(OngletNom(j&))
      S2.Activate
      If S2.UsedRange.Address = "$A$1" And S2.Range("a1") = "" Then
        Set R = S2.Range("b" & S2.UsedRange.Rows.Count & "")
      Else
        Set R = S2.Range("b" & S2.UsedRange.Rows.Count + 1 & "")
      End If
      R.Select
      ActiveSheet.Paste
      R.Offset(0, -1) = WB.Name
      S2.[a1].Select
      Application.CutCopyMode = False
    End If
  Next j&
  WB.Close savechanges:=False
  Set WB = Nothing
Next i&
If Log$(1, 1) <> "" Then
If Err = 9 Then Exit Sub
Set S = WBnew.Sheets.Add(after:=WBnew.Sheets(WBnew.Sheets.Count))
S.Name = "Log"
S.Range(S.Cells(1, 1), S.Cells(UBound(Log$, 2), _
    UBound(Log$, 1))) = WorksheetFunction.Transpose(Log$)
S.Columns.AutoFit
End If
Application.ScreenUpdating = True
End Sub

Par précaution, faites un test en faisant une COPIE de tous vos classeurs.

MARCHE A SUIVRE
1) Adaptez éventuellement, à votre usage, les lignes de code entre les ###
2) Réunissez tous vos classeurs dans un dossier (nommez ce dossier "Chiffriers" par exemple)
3) Lancez la macro FusionOnglets
4) Dans la boîte "Rechercher un dossier" parcourez pour sélectionner le dossier "Chiffriers"

Normalement, vous devez obtenir les résultats dans un nouveau classeur qui contiendra les
fusions des 4 feuilles choisies. Une feuille de rapport "Log" est créée en cas d'anomalie.

Comme vous n'avez pu joindre, pour cause de confidentialité, un classeur à votre demande, j'ai fait
le programme de manière complètement abstraite et, pour cette raison, il y a de grands risques de plantage.

Cordialement.

PMO
Patrick Morange