Fusion / Compiler

BBr1981

XLDnaute Nouveau
Bonjour à tous,

Je suis tout nouveau ici est au vu de la nature de vos réponses je penses que je trouverai mon bonheur ici

Je vous explique mon problème

Je voudrais si possible mettre en place le système suivant :

J'ai 15 collaborateurs qui dispose d'un fichier identique de part la composition ( 1 feuille et 6 colonnes) chaque collaborateurs à son propres fichiers.

J'aimerai créer un fichier permettant de regrouper l'ensemble des informations des 15 fichiers dans un seul.

Sachant que :

- les 15 fichiers sont sur un reseaux commum dans un seul est même repertoire ils sont intitulés de cette facon : NOM_ANNEE.xls

- Les 15 fichiers peuvent être modifier durant la journée en gros mise à jour ajout de ligne

- Le fichier global doit pouvoir se mettre à jour constament durant la journée avec les nouvelles entrées rentrée par les 15 collaborateurs.

Version Excel 2010 !


Celon vous est ce que cela est possible sans avoir à faire intervenir Accès ou dois-je me tirer une balle ?



Merci par avance
 
G

Guest

Guest
Re : Fusion / Compiler

Bonjour,

Peut-être en ajoutant une connexion MsQuery (onglet/données/Autres sources/MsQuery) par feuille et par fichier. La fréquence de mise à jour est paramétrable. Il vaut mieux qu'elle ne se mettent pas à jour en même temps. A voir; si cela ne provoque pas trop de ralentissements.

A+
 
Dernière modification par un modérateur:

KROMS

XLDnaute Nouveau
Re : Fusion / Compiler

Bonjour, Etant nulle en VBA, j'aurais tendance à vous proposer une solution alternative avec des google docs

Google docs permet de partager des documents en temps réel. C'est sécurisé, cela reprend le look d'excel en moins bien, mais l'utilisateur s'y retrouve. l'avantage c'est que cela permet de suivre les modifications.

Dans le principe chaque utilisateur remplit son tableau en ligne dans un google doc et le partage en lecture et/ou modification avec vous.

Vous créez un classeur à vous qui reprend le contenu de chacun des tableaux, avec importrange("clé du document"), et le téléchargez en excel quand vous en avez besoin.

Le cas échéant, la macro ci-dessous vous permet de compiler à la suite l'ensemble des données dans un onglet récapitulatif :
Sub Combine()
Dim J As Integer
Dim dl As Long
Dim x As Long
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Selection.CurrentRegion.Select ' select all cells in this sheets
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
With Sheets("Combined")
dl = .Range("A65536").End(xlUp).Row
For x = dl To 2 Step -1
If .Cells(x, 1).Value = 0 Then .Rows(x).Delete
Next x
End With
End Sub
 

BBr1981

XLDnaute Nouveau
Re : Fusion / Compiler

D'accord !

Cependant la problématique est de compiler tous les differents fichiers comportant 1 onglet identiques dans un autre fichier

1 = 15 fichiers o_O

Sans passer par du VBA ou Google je crois que c'est mal barré donc .
 

BBr1981

XLDnaute Nouveau
Re : Fusion / Compiler

Re bonjour,

J'ai donc ajouté les 15 fichiers par le biais de connections, à ceci j'ai programmé une mise à jour toutes les 15 minutes automatiquement.

Malheureusement il ne prend pas en compte les mise à jour mon fichier reste vierge.
 
G

Guest

Guest
Re : Fusion / Compiler

Re,

tous les cas sont uniques. Impossible pour moi de savoir si tu es passé à côté de quelque chose.

Quand tu as fait la première Requête (MS Query) est-ce qu'elle t'a retourné quelque chose?

A+
 

BBr1981

XLDnaute Nouveau
Re : Fusion / Compiler

Bonjour à tous !

Alors :

J'ai fait le boulet car je n'ai pas utiliser (onglet/données/Autres sources/MsQuery) mais (Données/Connexions)

Je ne peux pas utiliser MsQuery car pas installé sur ma machine et faut que je fasse une demande à la DSI bref c'est mort.

Donc cette solution est malheureusement impossible :/
 

BBr1981

XLDnaute Nouveau
Re : Fusion / Compiler

Bonjour !

Alors la premier fonction ne passe pas ainsi en gratouillant sur le net j'ai trouvé ceci :


Code:
Sub ConvertirFichiersEnFeuilles()
    Const Chemin = "Liens du repertoire"
    
    Dim VarListeFichiers As Variant, VarFichier As Variant, WkClasseur As Workbook, WkFinal As Workbook
    
    VarListeFichiers = Array("Fichier1.xlsx", "Fichiers2.xlsx")
    
    Set WkFinal = Workbooks.Add
    
    For Each VarFichier In VarListeFichiers
        WkFinal.Sheets.Add Type:=Chemin & VarFichier
    Next
   
End Sub

Cette macro est vraiment on bon début, car, je peux enfin regrouper dans un classeur l'ensemble des informations des mes 2 fichiers test. La problématique est qu'il ne me mets pas a jour les données automatiquement il me regenére un autre fichier a chaque fois. il est m'importe toutes les feuilles des classeurs alors que la premiere feuilles est seulement utilisable, je continu a chercher mais je crois qu'a un moment je vais bloquer xD

j'ai essayé de l'assembler avec un autre morceau ce qui donne :

Code:
Sub ConvertirFichiersEnFeuilles()
    Const Chemin = "[COLOR="Red"]Réperoire[/COLOR]"
    Dim VarListeFichiers As Variant, VarFichier As Variant, WkClasseur As Workbook, WkFinal As Workbook
    VarListeFichiers = Array("[COLOR="red"]Nom des fichiers.xlsx[/COLOR]", "[COLOR="red"]Nom des fichiers.xlsx[/COLOR]")
    
    Set WkFinal = Workbooks.Add
    
    For Each VarFichier In VarListeFichiers
        WkFinal.Sheets.Add Type:=Chemin & VarFichier
  Next
 
Consolidationpourimportation

Exit Sub
End Sub

Sub Consolidationpourimportation()
  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long

'--Suppression des messages d'alerte

Application.DisplayAlerts = False

'--Suppression des feuilles inutiles suite à l'importation

Sheets("Feuil2").Delete
Sheets("Feuil3").Delete

'--Copié/collé des données sur la Feuil1

For Ctr = 1 To Sheets.Count - 1
  Sheets("feuil1").Activate
   Col = "a"
  NumLig = 0
  With Sheets(Ctr)
  NbrLig = .Cells(65536, Col).End(xlUp).Row
  For Lig = 2 To NbrLig
    If .Cells(Lig, Col).Value <> "" Then
      .Cells(Lig, Col).EntireRow.Copy
      NumLig = NumLig + 1
      Sheets("feuil1").Cells(NumLig, 1).Insert Shift:=xlDown
    End If
  Next
  End With
Next Ctr

'--Nommer "feuil1" et mise en place des noms des colonnes

ActiveSheet.Name = "importation"
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Date / Heure"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Numéro de téléphone et/ou nom & Prénom"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Activité"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Ligne"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Logiciel"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Probléme rencontré"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Status"

'--Suppression des onglets sauf celui qui est actif

  For Ctr = Sheets.Count To 1 Step -1
    If Sheets(Ctr).Name <> ActiveSheet.Name Then
      Sheets(Ctr).Delete
    End If
  Next

'--Mise en page

Cells.Select
Selection.Columns.AutoFit
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
    orderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

End Sub

Mais la plus rien ne marcue :cry::cry::cry:
 
G

Guest

Guest
Re : Fusion / Compiler

Bonjour,

Voici une macro qui ira lire les données d'une feuille dans un classeur distant.

Il faut lui passer comme argument le nom du fichier source complet (chemin\fichier.xlsx)
le nom de la feuille dont il faut importer les informations
et le nom de la feuille destination dans le classeur de synthèse (si la feuille destination n'existe pas elle sera créée)
Exemple d'appel:

ImportationMsAdo "C:\documents\mes sources de données\lefichier.xls", "FeuilleTata", "FeuilleToto"


Code:
Sub ImportationMsAdo(FichierSource As String, NomFeuilleSource As String, NomFeuilleDestination As String)
    Dim oCnx As Object, rs As Object
    Dim i As Integer
    Dim shDestination As Worksheet
    Set shDestination = GetWorkSheet(NomFeuilleDestination, ThisWorkbook)
    Set oCnx = CreateObject("Adodb.Connection")
    oCnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FichierSource & ";Extended Properties=""Excel 12.0;HDR=YES"";"
    oCnx.CursorLocation = 3    'adUseClient
    Set rs = oCnx.Execute("SELECT * FROM [" & NomFeuilleSource & "$];")
    With shDestination
        'Mettre les noms de champs en entête
        For i = 1 To rs.Fields.Count
            .Cells(1, i - 1) = rs.Fields(i).Name
        Next
        'Copier les données retournées
        .Range("A2").CopyFromRecordset rs
    End With
    Set rs = Nothing
    Set oCnx = Nothing
End Sub
Function GetWorkSheet(SheetName As String, Optional Wkb As Workbook = Nothing, Optional CreateIfNotExists As Boolean = True) As Worksheet
    'Hasco
    If Wkb Is Nothing Then Set Wkb = ActiveWorkbook
    On Error Resume Next
    Set GetWorkSheet = Wkb.Sheets(SheetName)
    If GetWorkSheet Is Nothing And CreateIfNotExists Then
        Set GetWorkSheet = Wkb.Sheets.Add
        GetWorkSheet.Name = SheetName
    End If
End Function

A+
 

Discussions similaires

Statistiques des forums

Discussions
312 496
Messages
2 088 974
Membres
103 995
dernier inscrit
Flodk