Base de données - Optimisation

B

bobylaroche

XLDnaute Occasionnel
Bonjour à tous,

J'ai réalisé une petite base de données et je souhaiterai y porter une modification pour optimiser la vitesse d'importation. Une explication s'impose.

Dans un même dossier figure un classeur "BD" (base de données) et un certain nombre de classeurs sources.
En cliquant sur le bouton "Importation" du classeur BD, j'importe une plage de la feuille "DAT" figurant dans chacun des classeurs sources.

Cela fonctionne mais l'importation rame lorsque la BD devient conséquente.
La cause, c'est l'importation et l'ajout d'une ligne par le dessus, ce qui oblige à décaler vers le bas le bloc de données existant.

La solution serait d'ajouter chaque nouvelle importation à la dernière ligne+1 mais je n'y parviens pas.

Si l'une ou l'un d'entre vous a une solution, merci ;)

Pour une meilleure compréhension, 3 fichiers sources et le fichier BD en pièce jointe.
 

Pièces jointes

  • BD.xlsm
    1.6 MB · Affichages: 33
  • 1.xlsx
    15.4 KB · Affichages: 26
  • 2.xlsx
    15.4 KB · Affichages: 23
  • 3.xlsx
    15.4 KB · Affichages: 22
Trier par date Trier par votes
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Bonjour bobylaroche

Si tu veux copier à la suite c'est :
Wb.Sheets("DAT").Range("AY34:Jx34").Copy Range("b" & Rows.Count).End(xlUP)(2)


À remplacer par celle que tu as faite.
VB: 
Sub Nouvellecourse1()
Dim ShD As Worksheet, ShI As Worksheet

    Set ShD = Sheets("DATA"): Set ShI = Sheets("IMPORT")
    Application.WindowState = xlMaximized

    ShD.Rows("5:5").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    ShI.Range("b5:hx5").Copy
    ShD.Range("b5").PasteSpecial xlPasteValues
    Application.CutCopyMode = 0
    Application.Goto ShI.Range("a1")
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour le fil, bonjour le forum,

Je n'ai pas compris l'intérêt de l'onglet Import !?... Je ferai plutôt comme ça :
VB: 
Sub macro1()
Dim CD As Workbook 'déclare la variabe CD (Classeur Destination)
Dim CA As String 'déclare la variabe CA (Chemin d'Accès)
Dim CS As Workbook 'déclare la variabe CS (Classeur Source)
Dim OD As Worksheet 'déclare la variabe OD (Onglet Destination)
Dim OS As Worksheet 'déclare la variabe OD (Onglet Source)
Dim DEST As Range 'déclare la variabe DEST (cellule de DESTination)
Dim F As String 'déclare la variabe F (Fichier)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Application.DisplayAlerts = False 'masque les messages d'Excel
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("DATA") 'défint l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xlsx") 'définit le premier ficher .xlsx du dossier du chemin d'accès CA
Do While F <> "" 'boucle tant qu'il existe des fichiers
    Workbooks.Open CA & F 'ouvre le fichier F
    Set CS = ActiveWorkbook 'définit le classeur source CS
    Set OS = CS.Worksheets("DAT") 'définit l'onglet source CS
    'définit la cellule de destiantion DEST (B5 si B5 est vide, sinon, la première cellule vide de la colonne B de l'onglet OD
    If OD.Range("B5").Value = "" Then Set DEST = OD.Range("B5") Else Set DEST = OD.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)
    OS.Range("AY34:JX34").Copy 'copy la plage AY34:JX34 de l'onglet source OS
    DEST.PasteSpecial (xlPasteValues) 'colle les valeur dans DEST
    DEST.PasteSpecial (xlPasteFormats) 'colle les formats dans DEST
    CS.Close False 'ferme le classeur source sans enregistrer
    F = Dir 'définit le prochain classeur .xlsx du dossier du chemin d'accès CA
Loop 'boucle
Application.DisplayAlerts = True 'affiche les messages d'Excel
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
 
Vote positif 0 Vote négatif
B

bobylaroche

XLDnaute Occasionnel
Lone-wolf à dit:
Bonjour bobylaroche

Si tu veux copier à la suite c'est :
Wb.Sheets("DAT").Range("AY34:Jx34").Copy Range("b" & Rows.Count).End(xlUP)(2)


À remplacer par celle que tu as faite.
VB: 
Sub Nouvellecourse1()
Dim ShD As Worksheet, ShI As Worksheet

    Set ShD = Sheets("DATA"): Set ShI = Sheets("IMPORT")
    Application.WindowState = xlMaximized

    ShD.Rows("5:5").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    ShI.Range("b5:hx5").Copy
    ShD.Range("b5").PasteSpecial xlPasteValues
    Application.CutCopyMode = 0
    Application.Goto ShI.Range("a1")
End Sub
Cliquez pour agrandir...






Bonjour et merci Lone-wolf :)

Merci bien pour les solutions proposées, c'est sympa :)
Vu ma tendance bidouilleur, j'ai quelques soucis pour effectuer les modifications :(

Si je remplace la sub par celle proposée, rien ne change, la dernière importation s'effectue en première ligne et pas en dernière.
Si je remplace la ligne de code proposée et la sub, ça bug sur Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False

Bloup, bloup, comprends pas !
 
Vote positif 0 Vote négatif
B

bobylaroche

XLDnaute Occasionnel
Robert à dit:
Bonjour le fil, bonjour le forum,

Je n'ai pas compris l'intérêt de l'onglet Import !?... Je ferai plutôt comme ça :
VB: 
Sub macro1()
Dim CD As Workbook 'déclare la variabe CD (Classeur Destination)
Dim CA As String 'déclare la variabe CA (Chemin d'Accès)
Dim CS As Workbook 'déclare la variabe CS (Classeur Source)
Dim OD As Worksheet 'déclare la variabe OD (Onglet Destination)
Dim OS As Worksheet 'déclare la variabe OD (Onglet Source)
Dim DEST As Range 'déclare la variabe DEST (cellule de DESTination)
Dim F As String 'déclare la variabe F (Fichier)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Application.DisplayAlerts = False 'masque les messages d'Excel
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("DATA") 'défint l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xlsx") 'définit le premier ficher .xlsx du dossier du chemin d'accès CA
Do While F <> "" 'boucle tant qu'il existe des fichiers
    Workbooks.Open CA & F 'ouvre le fichier F
    Set CS = ActiveWorkbook 'définit le classeur source CS
    Set OS = CS.Worksheets("DAT") 'définit l'onglet source CS
    'définit la cellule de destiantion DEST (B5 si B5 est vide, sinon, la première cellule vide de la colonne B de l'onglet OD
    If OD.Range("B5").Value = "" Then Set DEST = OD.Range("B5") Else Set DEST = OD.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)
    OS.Range("AY34:JX34").Copy 'copy la plage AY34:JX34 de l'onglet source OS
    DEST.PasteSpecial (xlPasteValues) 'colle les valeur dans DEST
    DEST.PasteSpecial (xlPasteFormats) 'colle les formats dans DEST
    CS.Close False 'ferme le classeur source sans enregistrer
    F = Dir 'définit le prochain classeur .xlsx du dossier du chemin d'accès CA
Loop 'boucle
Application.DisplayAlerts = True 'affiche les messages d'Excel
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
Cliquez pour agrandir...








Bonjour et merci bien Robert,

Je galère, j'ai remplacer mama cro ;) par celle proposée mais elle ne s'éxecute pas, rien ne se passe !

Tu as raison, l'importation aurait pu se faire directement depuis l'onglet DATA mais je suis parti d'un fichier basic sans importation en lot et je l'ai bidouillé. C'est pour cette raison que la plage est collée une première fois en feuille import.

En bref, je nage.
 
Vote positif 0 Vote négatif
B

bobylaroche

XLDnaute Occasionnel
Merci Robert pour ton aide, c'est gentil.

J'ai toujours une erreur et je viens d'en comprendre l'origine sans en connaitre la raison.

C'est une bourde de ma part, ton classeur fonctionne super bien avec les 3 classeurs sources fournis enregistrés au format xlsx.
Ceux que j'utilise sont en fait au format xlsm car ils comportent des macros.

J'ai donc remplaçé "F = Dir(CA & "*.xlsx")" par "F = Dir(CA & "*.xlsm") mais rien n'y fait.

En résumé, le classeur fonctionne pour les classeurs sources exemples au format xlsx mais aucune importation ou plantage d'excel pour le format xlsm ! C'est du Chinois.
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re,

Essaie comme ça :
VB: 
Sub macro1()
Dim CD As Workbook 'déclare la variabe CD (Classeur Destination)
Dim CA As String 'déclare la variabe CA (Chemin d'Accès)
Dim CS As Workbook 'déclare la variabe CS (Classeur Source)
Dim OD As Worksheet 'déclare la variabe OD (Onglet Destination)
Dim OS As Worksheet 'déclare la variabe OD (Onglet Source)
Dim DEST As Range 'déclare la variabe DEST (cellule de DESTination)
Dim F As String 'déclare la variabe F (Fichier)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Application.DisplayAlerts = False 'masque les messages d'Excel
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("DATA") 'défint l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xls*") 'définit le premier ficher .xls* du dossier du chemin d'accès CA
Do While F <> "" 'boucle tant qu'il existe des fichiers
    If F <> CD.Name Then 'condition : si F est différent du nom du fichier actuel
        Workbooks.Open CA & F 'ouvre le fichier F
        Set CS = ActiveWorkbook 'définit le classeur source CS
        Set OS = CS.Worksheets("DAT") 'définit l'onglet source CS
        'définit la cellule de destiantion DEST (B5 si B5 est vide, sinon, la première cellule vide de la colonne B de l'onglet OD
        If OD.Range("B5").Value = "" Then Set DEST = OD.Range("B5") Else Set DEST = OD.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)
        OS.Range("AY34:JX34").Copy 'copy la plage AY34:JX34 de l'onglet source OS
        DEST.PasteSpecial (xlPasteValues) 'colle les valeur dans DEST
        DEST.PasteSpecial (xlPasteFormats) 'colle les formats dans DEST
        CS.Close False 'ferme le classeur source sans enregistrer
    End If 'fin de la condition
    F = Dir 'définit le prochain classeur .xls* du dossier du chemin d'accès CA
Loop 'boucle
Application.DisplayAlerts = True 'affiche les messages d'Excel
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

chajmi
  • Question
XL 2021 Base de données avec images
2
Réponses
21
Affichages
581
patricktoulon
patricktoulon
S
  • Résolu(e)
Microsoft 365 - Conseils pour la structuration d'une base de données -
2 3
Réponses
44
Affichages
3 K
crocrocro
C
E
  • Question
XL 2013 Base de données
2
Réponses
15
Affichages
1 K
eutrophisation
E
KTM
  • Question
XL 2019 Regrouper les données de plusieurs feuilles dans une seule Feuille
Réponses
9
Affichages
399
Oneida
Oneida
G
  • Question
Microsoft 365 Optimisation de formule
Réponses
6
Affichages
478
guiyom
G
D
  • Résolu(e)
XL 2021 VBA Formulaire
2
Réponses
27
Affichages
1 K
delsart59
D
MBax
  • Résolu(e)
Microsoft 365 Extraction d'informations sur différents onglets en partant d'une base de données
Réponses
7
Affichages
492
MBax
MBax
A
  • Question
Power Query Variabiliser automatiquement une source de données PQ selon l’utilisateur
Réponses
3
Affichages
550
chris
chris
G
  • Question
XL 2016 comment regrouper les données de plusieurs feuille dans une seule par une macro
Réponses
4
Affichages
609
GUEWOU
G
L
  • Question
XL pour MAC tableau ans perturbation des colonnes non copié
Réponses
5
Affichages
568
DJunqueira
D

Membres actuellement en ligne

12 membres et 135 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 717
Messages
2 112 169
Membres
111 450
dernier inscrit
nath_omic