Programation VBA excel

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

:tagcode:

La grosse colonne de Range(Selection, Selection.End(xlDown)).Select est sûrement remplaçable par un truc d'une seule ligne. Je ne connais pas les propriétés de Range, mais je suis sûr que tu peux ajouter X lignes à une Range sans avoir là le faire ligne par ligne.
De plus, la propriété Selection ne retourne-t-elle pas elle-même une Range?

Bonjour,

Pour ajouter 10 lignes, le plus simple c'est d'enregistrer une macro en insérant 10 lignes d'un coup. Vite fait:

Code:

---

1 2 3 4 5 6

Sub Macro1() ' Range("A1:A10").Select Selection.EntireRow.Insert End Sub

---

Quant à savoir pourquoi tu importes trop de lignes, ma boule de cristal est cassée.

P.S Le forum VBA Excel est au bout de ce lien