Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Récupérer le contenu de cellule par VBA

telemarrk

XLDnaute Occasionnel
Bonjour,

Je voulais savoir si par le biais d'un code VBA, on peut remplir les cellules d'un tableau en allant chercher les infos sur d'autres fichiers Excel.

Explication :

J'ai un fichier général "TEST" et 4 fichiers : SGCS - SGST - SGINFORMAT - SGCULTURE

Je voudrais mettre dans mon tableau TEST le contenu des cellules L6 et M6 des quatre fichiers.

Je vous joins le fichier test et deux fichiers

Merci
 

Pièces jointes

  • test.xlsx
    8.2 KB · Affichages: 5
  • sgcs.xlsx
    8.2 KB · Affichages: 6
  • sgst.xlsx
    8.2 KB · Affichages: 5
Dernière édition:

job75

XLDnaute Barbatruc
En fait d'après ce que je comprends il faut copier toutes les cellules des tableaux, de A à M :
VB:
Private Sub Workbook_Activate()
Dim chemin$, fichier$, feuille$, lig&, form$, h&
chemin = ThisWorkbook.Path & "\" 'dossier commun
fichier = Dir(chemin & "SG*.xls*") '1er fichier du dossier
feuille = "Factures" 'nom des feuilles
lig = 5 '1ère ligne de restitution
Application.ScreenUpdating = False
With Sheets(feuille)
    If .ListObjects.Count Then .ListObjects(1).Unlist 'convertit le tableau structuré en plage
    Range(lig & ":" & .Rows.Count).Delete 'RAZ
    While fichier <> ""
        form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
        h = ExecuteExcel4Macro("MATCH(""zzz""," & form & "C12)")
        If h > 4 Then
            With .Cells(lig, 1).Resize(h - 4, 13) 'plage de A à M
                .FormulaArray = "=""""&" & form & "A5:M" & h 'formule matricielle
                .Value = .Value 'supprime la formule
            End With
            lig = lig + h - 4
        End If
        fichier = Dir 'fichier suivant
    Wend
    With .Range("H5:H" & .Rows.Count)
        .Replace ",", ".", xlPart 'remplace la virgule par le point
        .Replace " ", "", xlPart 'supprime les espaces
    End With
    .ListObjects.Add xlSrcRange, Range("A4:M" & lig - 1), , xlYes 'recrée le tableau structuré
End With
End Sub
 

Pièces jointes

  • Consolidation.xlsm
    20.2 KB · Affichages: 3
  • SGCS.xlsm
    11.8 KB · Affichages: 1
  • SGCULTURE.xlsm
    11.7 KB · Affichages: 2

telemarrk

XLDnaute Occasionnel
Bonjour job75

Cela fonctionne, le but est de traiter une trentaine de fichiers SG, j'ai fait par liaison mais je trouve que mon fichier Consolidation était un peu lourd (fichier sur serveur) c'est pourquoi je voulais savoir s'il existait un moyen en VBA.

J'ai une dernière petite question, j'ai déjà un code VBA dans ThisWorkbook (Open) si je mets ton en-dessous cela va fonctionner


Merci pour ton aide
 

job75

XLDnaute Barbatruc
Je reviens ici car on peut ne pas convertir le tableau structuré en plage.

Et dans ce cas il ne faut pas y entrer de formule matricielle :
VB:
Private Sub Workbook_Activate()
Dim chemin$, fichier$, feuille$, i&, form$, h&
chemin = ThisWorkbook.Path & "\" 'dossier commun
fichier = Dir(chemin & "SG*.xls*") '1er fichier du dossier
feuille = "Factures" 'nom des feuilles
Application.ScreenUpdating = False
With Sheets(feuille).ListObjects(1) 'eableau structuré
    i = 2 '1ère ligne de restitution
    If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete 'RAZ
    While fichier <> ""
        form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
        h = ExecuteExcel4Macro("MATCH(""zzz""," & form & "C12)")
        If h > 4 Then
            With .Range(i, 1).Resize(h - 4, 13) 'plage de A à M
                .Formula = "=""""&" & form & "A5" 'référence relative de la 1ère cellule copiée
                .Value = .Value 'supprime les formules
            End With
            i = i + h - 4
        End If
        fichier = Dir 'fichier suivant
    Wend
    If i = 2 Then Exit Sub
    With .DataBodyRange.Columns(8)
        .Replace ",", ".", xlPart 'remplace la virgule par le point
        .Replace " ", "", xlPart 'supprime les espaces
    End With
End With
End Sub
 

Pièces jointes

  • Consolidation.xlsm
    20.5 KB · Affichages: 4
  • SGCS.xlsm
    11.8 KB · Affichages: 3
  • SGCULTURE.xlsm
    11.7 KB · Affichages: 3

job75

XLDnaute Barbatruc
Bonjour telemarrk,

Quelle différence entre formule matricielle et non matricielle ?

J'ai testé avec un fichier SGCS contenant un tableau de 13 x 100000 (1 300 000 cellules avec "a") :

- macro du post #31 => 5,5 secondes

- macro du post #35 => 12,5 secondes.

A+
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…