Consolider fichiers excel

G

gillesbe

XLDnaute Nouveau
bonjour a toutes et á tous
Novice du premier degré en programation VBA sous Excel, j'ai rassemblé plusieurs informations qui m'ont permises d'écrire un code d'importation
et de consiolidation de plusieurs feuilles excel.
Le code semble fonctionner, mais je n'arrive pas a diminuer le nombre de lignes importées par feuille (au alentour de 20.000) ou en réalité je dois en avoir
au maximum 500!!!
Si un de vous pouviez m'aider, je vous en serai trés reconnaissant
Par la même occasion, si vous penser qu'il soit possible d'optimiser (j'en suis certain) l'écriture de ce programme, ne vous gêner pas.

Par avance merci pour votre retour.

Sheets("3. Prospecção").Select
Sheets("3. Prospecção1").Visible = True
Sheets("3. Prospecção1").Select
Range("A1").Select
Cells.Delete
Range("b2") = "1. Empresa"
Range("c2") = "2. Nome da Unidade"
Range("d2") = "3. Contato"
Range("e2") = "4. Telefone"
Range("f2") = "5. Vendedor Responsável"
Range("g2") = "6. Área de Venda"
Range("h2") = "7. Serviço Oferecido"
Range("i2") = "8. Categoria de Serviço"
Range("J2") = "9. Valor do Negócio"
Range("K2") = "10. Primeiro Contato"
Range("L2") = "Contato Realizado"
Range("M2") = "Reunião 1"
Range("n2") = "Reunião 2"
Range("o2") = "Negociação"
Range("p2") = "Ganho"
Range("q2") = "Perdido"
Range("r2") = "12. Último Contato"
Range("s2") = "13. Motivo da Perda"
Range("b2:x2").Font.Bold = True

' Parcours de tous les fichiers
' ------------------------------
ChDir "C:\GRSA\Analise Mercado DOR\Import"
ClasseurRegional = Dir("C:\GRSA\Analise Mercado DOR\Import\*.xlsx")
While Len(ClasseurRegional) > 0
Workbooks.Open ClasseurRegional
Sheets("3. Prospecção").Select
AvantDerniereLigne = ActiveSheet.UsedRange.Rows.Count - 1
Range("b8:s" & AvantDerniereLigne).Copy
Workbooks("PipeLine DOR.xlsm").Activate
Sheets("3. Prospecção1").Select
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 2
Range("B" & ActiveSheet.UsedRange.Rows.Count + 2).Select
ActiveSheet.Paste
Range("A" & DebutNomFichier & ":A" & ActiveSheet.UsedRange.Rows.Count) = ClasseurRegional
Workbooks(ClasseurRegional).Close
ClasseurRegional = Dir
Wend
Columns("A:A").Replace ".xlsx", ""
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("3. Prospecção").Select
Range("B8:S1000000").Select
Selection.ClearContents
Sheets("3. Prospecção1").Select
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("3. Prospecção1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("3. Prospecção1").Sort.SortFields.Add Key:=Range( _
"F3:F147903"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("3. Prospecção1").Sort
.SetRange Range("B2:S147903")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
Range("B3:S9500").Select
Selection.Copy
Sheets("3. Prospecção").Select
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("3. Prospecção1").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("3. Prospecção").Select
Range("A1").Select
End Sub
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Consolider fichiers excel

Bonjour à tous

gillesbe[Bienvenue sur le forum]
Tu peux alléger ton code par exemple pour remplir la ligne 2
VB: 
Dim a$, arrENT
a = "1. Empresa|2. Nome da Unidade|3. Contato|4. Telefone|5. Vendedor Responsável|6. Área de Venda|7. Serviço Oferecido|8. Categoria de Serviço|9. Valor do Negócio|10. Primeiro Contato|Contato Realizado|Reunião 1|Reunião 2|Negociação|Ganho|Perdido|12. Último Contato|13. Motivo da Perda"
arrENT = Split(a, "|"): Range("B2:S2") = arrENT
remplacera en moins de lignes , cette partie de ton code VBA.
Code: 
Range("b2") = "1. Empresa"
Range("c2") = "2. Nome da Unidade"
Range("d2") = "3. Contato"
Range("e2") = "4. Telefone"
Range("f2") = "5. Vendedor Responsável"
Range("g2") = "6. Área de Venda"
Range("h2") = "7. Serviço Oferecido"
Range("i2") = "8. Categoria de Serviço"
Range("J2") = "9. Valor do Negócio"
Range("K2") = "10. Primeiro Contato"
Range("L2") = "Contato Realizado"
Range("M2") = "Reunião 1"
Range("n2") = "Reunião 2"
Range("o2") = "Negociação"
Range("p2") = "Ganho"
Range("q2") = "Perdido"
Range("r2") = "12. Último Contato"
Range("s2") = "13. Motivo da Perda"

grisan29: Merci d'avoir indiqué ce multipost (puisque le demandeur n'a pas pensé à le faire ...:rolleyes:)
 
Dernière édition:
Vote positif 0 Vote négatif
G

gillesbe

XLDnaute Nouveau
Re : Consolider fichiers excel

Bonsoir et Merci de ce retour trés rapide
Sympa de votre part

J'ai bien effectué les modifications et cela fonctionne tout aussi bien
Comme vous pouvez le voir j'ai plusieurs :
Range(Selection, Selection.End(xlDown)).Select
pour la raison que j'ai des lignes d'intervalles entre les données que je dois recopier vers un autrre classeur..


De la même maniere j'importe 20.000 lignes de données lorqu'en réalité je n'en ai besoin que +- 500
 
Vote positif 0 Vote négatif
G

gillesbe

XLDnaute Nouveau
Re : Consolider fichiers excel

Merci pascal de ta prompte réponse

vu mon pauvre niveau de programmeur, j'ai tout planté :(
sur le probleme spécifique d'importation de 20.000 au lieu de 500 qui correspondent aux lignes réelement utilisées
quelles instruction puis je ecrire en complement !

sLTS
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Consolider fichiers excel

Re


Voici un exemple pour importer 500 lignes seulement
1) dans un fichier créé pour l'occasion, remplis 600 lignes
(en utilisant la recopie vers le bas et vers la droite: donc jusqu'en ligne 600 et en colonne D)
tu auras des valeurs dans les cellules [noparse]A1:D600[/noparse]
2) enregistres ce fichier dans c:\temp en lui donnant le nom testimport.xlsx puis ferme ce fichier
3) Dans un nouveau fichier, copies dans un module la macro ci-dessou puis lances-là
Code: 
Sub Import500LignesMAX()
Dim wBKi As Workbook, t
Set wBKi = Workbooks.Open(Filename:="C:\Temp\testimport.xlsx")
t = wBKi.Sheets(1).Range("A1:D500").Value
ThisWorkbook.Sheets(1).Cells(1, 1).Resize(UBound(t, 1), UBound(t, 2)) = t
wBKi.Close False
End Sub
Tu auras alors importé 500 lignes et pas une de plus ;)

Ensuite, il te restera à mixer ce code VBA exemple avec ton code VBA existant.
 
Vote positif 0 Vote négatif
G

gillesbe

XLDnaute Nouveau
Re : Consolider fichiers excel

Staple1600

Comment puis je modifier cette ecriture pour quelle prenne en charge un nom d'onglet


t = wBKi.Sheets(3)

et de la meme maniere quelle recopie dans un onglet specifique dans une adresse specifique

Par avance merci

Sub Import500LignesMAX()
Dim wBKi As Workbook, t
Set wBKi = Workbooks.Open(Filename:="C:\Temp\testimport.xlsx")
t = wBKi.Sheets(1).Range("A1:D500").Value
ThisWorkbook.Sheets(1).Cells(1, 1).Resize(UBound(t, 1), UBound(t, 2)) = t
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Consolider fichiers excel

RE

gillesbe à dit:
Comment puis je modifier cette ecriture pour quelle prenne en charge un nom d'onglet
Cliquez pour agrandir...
Il faudrait commencer par lire les conseils que je te suggère ;)
Staple1600 à dit:
Ensuite, il te restera à mixer ce code VBA exemple avec ton code VBA existant.
Cliquez pour agrandir...
Donc un début de mixage pourrait être
Code: 
Sub Import500LignesMAXbis()
Dim wBKi As Workbook, t
' Parcours de tous les fichiers
' ------------------------------
ChDir "C:\GRSA\Analise Mercado DOR\Import"
ClasseurRegional = Dir("C:\GRSA\Analise Mercado DOR\Import\*.xlsx")
While Len(ClasseurRegional) > 0
Set wBKi = Workbooks.Open(ClasseurRegional)
t = wBKi.Sheets(3).Range("B8:S500").Value
ThisWorkbook.Sheets(1).Cells(1, 1).Resize(UBound(t, 1), UBound(t, 2)) = t
wBKi.Close False
ClasseurRegional = Dir
Wend
End Sub
 
Vote positif 0 Vote négatif
fhoest

fhoest

XLDnaute Accro
Re : Consolider fichiers excel

Bonjour Grisan29,Staples1600,Gillesbe
Je suis ravi pour toi que tu as trouvé réponse à ta demande,mais j'apprécierai que tu passes mettre le poste à jour de l'autre coté.
j'espère que tu ne feras plus ce genre de chose,c'est pas sympa pour les personnes qui t'aide.
A+
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Consolider fichiers excel

Bonjour fhoest, le fil, le forum

fhoest
Au moins ca fait plaisir de voir d'autres que moi partager le même avis à propos du multipostage
(je me sens moins seul d'un coup)
Ah ma pauvre netiquette, tu fus bien vite oubliée ...
Sans doute parce que tu viens d'un autre siècle ;)
Allez juste pour honorer ton souvenir , un petit lien ;)
http://www.ccr.jussieu.fr/dsi/doc/divers/Netiquette.htm
et pis un autre
Multipostage [Wikipédia]


Comme cela gillesbe saura de quoi on cause ;)
 
Dernière édition:
Vote positif 0 Vote négatif
G

gillesbe

XLDnaute Nouveau
Re : Consolider fichiers excel

Bjr

Désolé si j'ai froissé des suceptibilités, mais c'était par ignorance.. vous l'aurez bien compris :rolleyes:
Merci Staple1600 to code à l'air de fonctionner,.. mais j'importe toujours 25000 lignes de mes classeurs regionaux!!

Cordialement

gilles
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Consolider fichiers excel

Bonjour à tous

gillesbe
Si le mixage du code est bien réalisé, normalement tu devrais n’avoir que 500 lignes
(puisque c'est ce qui se passe avec le test proposé dans le message #6 avec un seul classeur)
Donc remixes d'une autre façon ;)

PS: Maintenant que tu n'ignores plus rien de la netiquette et du multipostage, qu'attends-tu pour éditer tes messages (les premiers sur chaque forum) pour ajouter un lien vers l'une et l'autre question et réciproquement ? ;)
Ce qui présente l'avantage pour le lecteur de savoir que la question est postée à plusieurs endroits.
 
Vote positif 0 Vote négatif

Discussions similaires

Z
  • Question
Microsoft 365 Ajouter une étiquette de confidentialité via macro
Réponses
4
Affichages
777
onobyone
O
M
  • Résolu(e)
XL 2016 Filtre auto VBA
Réponses
3
Affichages
565
MickaeL_D
M
R
  • Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
1 K
TooFatBoy
TooFatBoy
I
  • Question
XL 2016 MACRO LENTE
Réponses
2
Affichages
720
ImNotJésus
I
F
  • Résolu(e)
XL 2010 Importer des données de plusieurs fichiers sans les ouvrir
Réponses
9
Affichages
1 K
Hasco
Hasco
D
  • Résolu(e)
erreur VBA
Réponses
4
Affichages
684
Dangdang
D
C
  • Question
XL 2019 1004 sur un ActiveSheet.Paste
Réponses
5
Affichages
316
Cheyenne_2021
C
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
P
  • Résolu(e)
Microsoft 365 VBA mise en forme tableau
Réponses
2
Affichages
914
Pdedieu
P
A
  • Résolu(e)
XL 2013 Code VBA incompatible avec version Excel
Réponses
2
Affichages
386
Averell1976
A

Membres actuellement en ligne

10 membres et 111 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
312 046
Messages
2 084 855
Membres
102 688
dernier inscrit
Biquet78