comment supprimer des lignes vides

Question

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

ThauTheme · Answer

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

Comment supprimer des lignes vides

1 réponse

Discussions similaires

Newsletters