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
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