Comment supprimer des lignes vides

buggy45 Messages postés 9 Statut Membre -  
ThauTheme Messages postés 1564 Statut Membre -
Bonjour,
J'ai fait en VBA un tableau récapitulatif issu de 6 fichiers différents.
Le rapatriement des données des 6 fichiers fonctionne bien, mais entre chaque fichier s'intercalent de nombreuses lignes vides.
comment faire pour que les 6 fichiers se suivent sans interruption dans mon tableau RECAP.
Je vous donne le début de mon code qui se répète 6 fois

Sub récap inscription scolaire ()
'ouverture dossier Karine'
Worbooks.Open "M:\ROY\Inscriptions scolaires\Karine.xlsx"\
ActiveSheet.UsedRange.Rows("3"& ActiveSheet.UsedRange.Rows.Count).Copy
Workbooks("recap 2016.xlsm").Activate
Workbooks("recap2016.xlsm").Sheets("Feuil").Range(A3").Select
Workbooks("recap2016.xlsm").Sheets("Feuil").Paste
Workbooks("Karine.xlsx").Close



Worbooks.Open "M:\ROY\Inscriptions scolaires\Valérie.xlsx"\
ActiveSheet.UsedRange.Rows("3"& ActiveSheet.UsedRange.Rows.Count).Copy
Workbooks("recap 2016.xlsm").Activate
DebutNomFichier =ActiveSheet.UsedRange.Rows.Count+1
Workbooks("recap2016.xlsm").Sheets("Feuil").Range("A"&
ActiveSheet.UsedRange.Rows.Count+1).Select
Workbooks("recap2016.xlsm").Sheets("Feuil").Paste
Workbooks("Valérie.xlsx").Close



Workbooks.Open "M:\ROY\Inscriptions scolairesinscription\Sophie.xlsx"
ActiveSheet.UsedRange.Rows("3:" & ActiveSheet.UsedRange.Rows.Count).Copy
Workbooks("recap 2016.xlsm").Activate
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
Workbooks("recap 2016.xlsm").Sheets("Feuil1").Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
Workbooks("recap 2016.xlsm").Sheets("Feuil1").Paste
Workbooks("Sophie.xlsx").Close

End Sub



Merci de vos réponses

1 réponse

Réponse 1 / 1
ThauTheme Messages postés 1564 Statut Membre 160
 
Bonjour Buggy, bonjour le forum,

Ton code modifié : 

Sub récap_inscription_scolaire()
Dim CD As Workbook
Dim OD As Worksheet
Dim CH As String
Dim CLS As Variant
Dim CS As Workbook
Dim OS As Worksheet
Dim DEST As Range

CH = "M:\ROY\Inscriptions scolaires\"
CLS = Array("Karine.xlsx", "Valérie.xlsx", "Sophie.xlsx")
Set CD = ThisWorkbook
Set OD = CD.Sheets("Feuil1")

For I = 0 To 2
    Worbooks.Open (CH & CLS(I))
    Set CS = ActiveWorkbook
    Set OS = CS.Sheets(1)
    Set DEST = IIf(OD.Range("A3") = "", OD.Range("A3"), OD.Range("A" & Application.Rows.Count).End(xlUp).Row + 1)
    'OS.UsedRange.Rows("3" & OS.UsedRange.Rows.Count).Copy DEST
    OS.Range("A3").CurrentRegion.EntireRow.Copy DEST
    CS.Close False
Next I
End Sub


J'ai remplacé UsedRange qui renvoie parfois des adresses loufoques par CurrentRegion mais je suis pas sûr que ça aille...

À plus,
ThauTheme
0