Extraire des donné de classeur fermé

Le 10/02/2009 à 21:25

bonjour

Jais crée 12 dossier (leur nom son les mois de l'année)

dans chaque dossier le nombre de classeur et équivalant au jour travaillé exemple (nom des classeur)------( 0101) -----(0201)-----(0301)…exemple pour le moi de janvier). Comment récupéré les donné dans un classeur récap

Les ligne de donné son (de c22 a n22 ainsi que o21).

La mise en forme des classeurs et identique je voudrai réunir les classeurs de chaque jour pour avoir un recap du moi et ce pour chaque moi.

voila un debut

Sub LitDatas()

Dim Fich$, Arr, L As Integer, C As Integer, N2 As String

Dim X As Integer, Y As Integer

Dim Chemin As String

'chemin des classeurs à adapter

Chemin = c:\Users\peygase\Desktop\JANVIER '

With ThisWorkbook.Sheets('Recap')

For C = 1 To 31

If C < 10 Then

N2 = 'récapitulaif journalier' & C

ElseIf C < 100 Then

N2 = 'Xl0' & C

Else: N2 = 'Xl' & C

End If

Fich$ = Chemin & N2

If .Range('A1') = '' Then

L = 0

Else: L = .Range('A65536').End(xlUp).Row

End If

'récup des données à partir de l'adresse d'une plage de cellules

' si noms de champ changer false en true

GetExternalData Fich, récapitulatifjournalier ', c22:l22, False, Arr

'récup des données à partir du nom d'une plage de cellules ()

' GetExternalData Fich, '', 'plagenommée', False, Arr

' .Range('A1', .Cells(UBound(Arr, 1), UBound(Arr, 2))).Offset(L, 0).Value = Arr

For X = 1 To UBound(Arr, 1) 'lignes

For Y = 1 To UBound(Arr, 2) 'colonnes

If Arr(X, Y) <> '' Then .Cells(X, Y).Offset(L, 0).Value = Arr(X, Y)

Next Y

Next X

Fich = ''

Next C

End With

End Sub

je suis nul en vba si quelqun peu maidé

merci d'avance

https://www.excel-pratique.com/~files/doc/0701.zip

https://www.excel-pratique.com/~files/doc/recap.zip

Le 10/02/2009 à 22:11

salut a tous

ton probleme est de reccupe des informations d'un fichier ferme sur un autre fichier exel que tu as ouvrer c'est ca ton probleme ?

jerome

Le 10/02/2009 à 22:14

oui

Le 10/02/2009 à 22:18

Les ligne de donné son (de c22 a n22 ainsi que o21).

La mise en forme des classeurs et identique je voudrai réunir les classeurs jour pour avoir un recap par moi et ce pour chaque moi. 8)

Toute aide me serais utile merci d'avance

les numero de fichier du 1 janvier donc 0101 au 31 decembre 3112

le classeur nommé 0101 ligne de transphere (c22 a n22) sur classeur nommé recap ligne c1 a n1

le classeur nommé 0201 ligne de transphere (c22 a n22) sur classeur nommé recap ligne c2 a n2

comment faire pour que ce soit automatique

voila ce qui me cause probleme

Le 10/02/2009 à 22:24

re bonsoir

ouvre un fichier exel vierge

met toi sur une cellule click sur fFx et tape =

va sur ton fichier ou tu veux reccuperer ton information et selectionne la cellule qui t'interesse

puis fait entrée

voila ton nouveau fichier exel a un lien vers ton fichier de base

si c'est ca ta solution dit le moi je te dirais la suite a+

Le 10/02/2009 à 22:52

ce nais pas pratique et le bute cé que ce soi automatique ma base de donné et basé sur 2006 2007 2008 2009 en raison de 30 fichier par moi ca fais 1400 feuill

de 11 celule

Le 10/02/2009 à 23:46

Salut le forum

Un code de Frédéeric Sigonneau

Attribute VB_Name = "ADOConsolidation"

'J'ai plusieurs fichiers xls, construits selon la même architecture.
'Une première ligne de "titres", puis des données, sur chacune des lignes.
'Je souhaite qu'un autre fichier "synthétise" tous les
'fichiers "sources".

'Une solution de consolidation utilisant ADO :
'Les données sont lues sans ouvrir les fichiers source et copiées
'dans le fichier cible à la suite des données déjà présentes.
'Les données lues et recopiées sont les données entières de la feuille passée en
'paramètre Source.
'fs, mpfe

Sub TestConso()
Dim Fich1$, Fich2$, Source1$, Source2$, Cible$
  Fich1 = "D:\Fichier1.xls"
  Fich2 = "D:\Fichier2.xls"
  Source1 = "Feuil1"
  Source2 = "Feuil1"
  Cible = "Feuil1"
  ConsoDatas Fich1, Source1, Cible
  ConsoDatas Fich2, Source1, Cible
End Sub

Public Sub ConsoDatas(NomFichier$, FeuilleSource$, FeuilleCible$)
'Va chercher dans le classeur NomFichier (sans l'ouvrir) les données
'de la feuille FeuilleSource et les copie dans la feuille FeuilleCible
'du classeur actif, à la suite des données (éventuellement) déjà présentes.
'(La ligne d'entêtes de FeuilleSource n'est pas importée)
'inspiré de Rob Bovey, mpep
'nécessite une référence à la librairie
'Microsoft ActiveX Data Object 2.x Library
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim Li&, FeuilleDest

    ''' Crée la chaîne de connexion
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & NomFichier & ";" & _
        "Extended Properties=Excel 8.0;"

    ' La requête est basée sur le nom de la feuille. Ce nom
    ' doit se terminer par un $ et doit être entouré de crochets droits.
    szSQL = "SELECT * FROM [" & FeuilleSource & "$];"

    Set rsData = New ADODB.Recordset
    rsData.Open szSQL, szConnect, adOpenForwardOnly, _
        adLockReadOnly, adCmdText

    'où envoyer les données :
    Set FeuilleDest = ActiveWorkbook.Sheets(FeuilleCible)
    Li = FeuilleDest.Range("A65536").End(xlUp).Row + 1
    'envoi sur la première ligne vide
    If Not rsData.EOF Then
      FeuilleDest.Range("A" & Li).CopyFromRecordset rsData
    Else
      'si la source était vide...
      MsgBox "Aucun enregistrement renvoyé.", vbCritical
    End If

    ''' On nettoie pour finir...
    rsData.Close
    Set rsData = Nothing

End Sub

Mytå

Le 10/02/2009 à 23:50

Re le forum

Dans la même lignée

'Pour lire et écrire dans un classeur fermé en utilisant ADO,
'la bibliothèque
'Microsoft ActiveX Data Objects 2.x Library
'doit être cochée dans Outils\Références du VBAProject.

' 1 - Obtenir des données d'un classeur fermé

Sub LitDatas()
Dim Fich$, Arr

  Fich = "d:\TestAdo.xls" 'à adapter

  'récup des données à partir de l'adresse d'une plage de cellules
  GetExternalData Fich, "Feuil1", "A1:G20", False, Arr

  'récup des données à partir du nom d'une plage de cellules ()
'  GetExternalData Fich, "", "plagenommée", False, Arr

  With ThisWorkbook.Sheets("Feuil1")
    .Range("A1", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr
  End With

End Sub

'renvoie les valeurs d'une plage de cellules contigües (srcRange)
'd'une feuille (srcSheet) d'un fichier (srcFile) fermé
'dans un tableau (outArr)
'le paramètre TTL indique si la plage a ou non une ligne d'entêtes
Sub GetExternalData(srcFile As String, _
                    srcSheet As String, _
                    srcRange As String, _
                    TTL As Boolean, _
                    outArr As Variant)
'd'après Héctor Miguel, mpep
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
Dim Arr

  Set myConn = New ADODB.Connection
  If TTL = True Then HDR = "Yes" Else HDR = "No"
  myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & srcFile & ";" & _
              "Extended Properties=""Excel 8.0;" & _
              "HDR=" & HDR & ";IMEX=1;"""
  Set myCmd = New ADODB.Command
  myCmd.ActiveConnection = myConn
  If srcSheet = "" _
    Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _
    Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" & srcRange & "`"
  Set myRS = New ADODB.Recordset
  myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
  ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
  myRS.MoveFirst
  Do While Not myRS.EOF
    For RS_n = 1 To myRS.RecordCount  'lignes
      For RS_f = 0 To myRS.Fields.Count - 1  'colonnes
        Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
      Next
      myRS.MoveNext
    Next
  Loop
  myConn.Close
  Set myRS = Nothing
  Set myCmd = Nothing
  Set myConn = Nothing

  outArr = Arr

End Sub

Mytå

Le 11/02/2009 à 00:28

mille merci je vais tésté tous ca cé pas gagné mais avec un forum comme ici ca ne devrais pas tardé

Rechercher des sujets similaires à "extraire donne classeur ferme"