Qupprimer des lignes vides d'un tableau créer en VBA

buggy45 Messages postés 9 Date d'inscription   Statut Membre Dernière intervention   -  
Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,
J'ai créer un code VBA pour créer un tableau dont les données sont issues de 4 autres tableau dans 4 classeurs différents.
Cependant sur mon tableau final s'insère des lignes vierges après les données de chaque classeur.
J'ai tout essayé mais je n'arrive pas à les supprimer.
Je souhaiterai terminer mon code VBA en y intégrant un autre code pour supprimer toutes ces lignes.
Soit il me faut mettre un code vba avant la fermeture de chaque classeur, soit un code avant la fermeture du 4ème classeur .
Pouvez-vous m'aider, je n'arrête pas de chercher et je ne trouve pas?
merci

5 réponses

  1.
    Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 785
     
    Bonjour

    Décaler toi un peu, j'arrive pas à voir ton écran et aujourd'hui ma boule de cristal reste opaque !

    Patrice
    1
    1. buggy45 Messages postés 9 Date d'inscription   Statut Membre Dernière intervention  
       
      voici le code que j'ai rentré:

      'Macro permettant de mettre les titres su tableau inscriptions scolaires
      Sub récap_inscription_scolaire()
      'ouverture dossier Karine"
      Workbooks.Open "M:\ROY\Inscriptions scolaires\Préparation inscription\Rentrée 2015\Tableaux inscriptions scolaires\Karine.xlsx"
      ActiveSheet.UsedRange.Rows("3:" & ActiveSheet.UsedRange.Rows.Count).Copy
      Workbooks("Recap.xlsm").Activate
      Workbooks("Recap.xlsm").Sheets("Feuil1").Range("A3").Select
      Workbooks("Recap.xlsm").Sheets("Feuil1").Paste
      'affichage du nom du fichier dans la colonne S
      Range("S3:S" & ActiveSheet.UsedRange.Rows.Count) = "Karine.xlsx"
      Application.CutCopyMode = False
      Workbooks("Karine.xlsx").Close
      'affichage du nom du fichier dans la colonne S
      'ouverture valerie
      Workbooks.Open "M:\XXXXXXXXX\\Rentrée 2015\Tableaux \Valerie.xlsx"
      'copies de données valérie
      ActiveSheet.UsedRange.Rows("3:" & ActiveSheet.UsedRange.Rows.Count).Copy
      Workbooks("Recap.xlsm").Activate
      DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
      Workbooks("Recap.xlsm").Sheets("Feuil1").Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
      Workbooks("Recap.xlsm").Sheets("Feuil1").Paste
      ActiveSheet.Range("S" & DebutNomFichier & ":S" & ActiveSheet.UsedRange.Rows.Count) = "valerie.xlsx"
      Application.CutCopyMode = False
      Workbooks("Valerie.xlsx").Close
      'ouverture so^phie
      Workbooks.Open "M:\XXXXXXXXX\\Rentrée 2015\Tableaux \Sophie.xlsx"
      \Rentrée 2015\Tableaux inscriptions scolaires\Sophie.xlsx"
      ActiveSheet.UsedRange.Rows("3:" & ActiveSheet.UsedRange.Rows.Count).Copy
      Workbooks("Recap.xlsm").Activate
      DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
      Workbooks("Recap.xlsm").Sheets("Feuil1").Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
      Workbooks("Recap.xlsm").Sheets("Feuil1").Paste
      ActiveSheet.Range("S" & DebutNomFichier & ":S" & ActiveSheet.UsedRange.Rows.Count) = "Sophie.xlsx"
      Application.CutCopyMode = False
      Workbooks("Sophie.xlsx").Close
      'ouverture Margarita'
      Workbooks.Open "M:\XXXXXXXXX\\Rentrée 2015\Tableaux \Margarita.xlsx"
      \Rentrée 2015\Tableaux inscriptions scolaires\Margarita.xlsx"
      ActiveSheet.UsedRange.Rows("3:" & ActiveSheet.UsedRange.Rows.Count).Copy
      Workbooks("Recap.xlsm").Activate
      DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
      Workbooks("Recap.xlsm").Sheets("Feuil1").Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
      Workbooks("Recap.xlsm").Sheets("Feuil1").Paste
      ActiveSheet.Range("S" & DebutNomFichier & ":S" & ActiveSheet.UsedRange.Rows.Count) = "Margarita.xlsx"
      Application.CutCopyMode = False
      Workbooks("Margarita.xlsx").Close
      'ouverture MarieLaurence'
      Workbooks.Open "M:\XXXXXXXXX\\Rentrée 2015\Tableaux \Marielaurence.xlsx"
      ActiveSheet.UsedRange.Rows("3:" & ActiveSheet.UsedRange.Rows.Count).Copy
      Workbooks("Recap.xlsm").Activate
      DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
      Workbooks("Recap.xlsm").Sheets("Feuil1").Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
      Workbooks("Recap.xlsm").Sheets("Feuil1").Paste
      ActiveSheet.Range("S" & DebutNomFichier & ":S" & ActiveSheet.UsedRange.Rows.Count) = "MarieLaurence.xlsx"
      Application.CutCopyMode = False
      Workbooks("MarieLaurence.xlsx").Close
      'ouverture Sandrine'
      Workbooks.Open "M:\XXXXXXXXX\\Rentrée 2015\Tableaux \Sandrine.xlsx"
      ActiveSheet.UsedRange.Rows("3:" & ActiveSheet.UsedRange.Rows.Count).Copy
      Workbooks("Recap.xlsm").Activate
      DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
      Workbooks("Recap.xlsm").Sheets("Feuil1").Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
      Workbooks("Recap.xlsm").Sheets("Feuil1").Paste
      ActiveSheet.Range("S" & DebutNomFichier & ":S" & ActiveSheet.UsedRange.Rows.Count) = "Sandrine.xlsx"
      Application.CutCopyMode = False
      Workbooks("Sandrine.xlsx").Close
      Les données de chaque tableau sont inscrits sur un fichier Recap.xlsm. Chaque fois que les données d'un tableau sont rapatriées dans le fichier recap s'ajoutent des lignes vides.
      J'ai donc mis le code suivant
      With ActiveSheet.UsedRange
      derLi = .Row + .Rows.Count - 1
      End With
      Application.ScreenUpdating = False
      For r = derLi To 1 Step -1
      If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
      Next r

      après Workbooks("Sandrine.xlsx").Close
      Mais cela ne marche pas.
      0
      1. buggy45 > buggy45 Messages postés 9 Date d'inscription   Statut Membre Dernière intervention  
         
        Merci pour tes infos, mais cela ne marche toujours pas.
        Le dossier Karine s'ouvre bien, mais ensuite j'ai erreur 13. Incompatibilité de type
        certainement sur la ligne du code
        wbk.Worksheets(1).Range("A3").CurrentRegion.EntireRow.Copy wsh.Range("A" & p°L)
        merci pour ton temps.
        0
      2. buggy45 > buggy45
         
        Je n'avais pas vu ton 2ème message. Avec mes excuses;
        oui ça fonctionne mais je souhaiterai avoir qu'une fois les titres. Or je les ai chaque fois que je vais chercher les données dans chaque dossier (donc autant de titre que de dossiers)
        Pour infos mes titres sont sur chaque tableau sur les lignes1 et 2. On commence les données sur la 3ème ligne
        Merci de ton aide
        0
      3. buggy45 > buggy45
         
        Hélas j'ai toujours les titres de l'autre tableau de données. Peut-être ai-je mal expliqué ce que je souhaite. J'ai différents tableaux de données avec les mêmes titres de colonnes. Je veux faire une compli de ces tableaux (Karine, Valérie...) avec une ligne de titre, et les données des différents tableaux les uns à la suite des autres.
        Merci de ton aide
        0
  2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour

    En attendant la boule de cristal, un exemple pour supprimer les lignes vides
    https://www.cjoint.com/?3Dvs3I69WWl

    Michel
    1
  3. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 785
     
    Bonjour,

    Essaies : 
    Sub récap_inscription_scolaire()
'Macro permettant de mettre les titres su tableau inscriptions scolaires
Dim rep As String       'Répertoire
Dim wbk As Workbook     'Fichier source
Dim wsh As Worksheet    'Feuille destination
Dim p°L As Long         'Première ligne
Dim d°L As Long         'Dernière ligne

rep = "M:\ROY\Inscriptions scolaires\Préparation inscription\Rentrée 2015\Tableaux inscriptions scolaires\"
Set wsh = Workbooks("Recap.xlsm").Worksheets("Feuil1")
wsh.Rows("3:" & wsh.Rows.Count).Clear

'ouverture dossier Karine
p°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp) + 1
Set wbk = Workbooks.Open(rep & "Karine.xlsx")
wbk.Worksheets(1).Range("A3").CurrentRegion.EntireRow.Copy wsh.Range("A" & p°L)
d°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp)
'affichage du nom du fichier dans la colonne S
wsh.Range("S" & p°L & ":S" & d°L) = wbk.Name
wbk.Close

'ouverture dossier Valerie
p°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp) + 1
Set wbk = Workbooks.Open(rep & "Valerie.xlsx")
wbk.Worksheets(1).Range("A3").CurrentRegion.EntireRow.Copy wsh.Range("A" & p°L)
d°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp)
'affichage du nom du fichier dans la colonne S
wsh.Range("S" & p°L & ":S" & d°L) = wbk.Name
wbk.Close

End Sub
    0
  4. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 785
     
    Bonjour,

    Désolé, j'ai été un peu trop rapide,
    Remplace 
    p°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp) + 1
    par 
    p°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row + 1

    et 
    d°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp)

    par 
    d°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row

    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 785
     
    Re,

    Essaies : 
    Sub récap_inscription_scolaire()
'Macro permettant de mettre les titres su tableau inscriptions scolaires
Dim rep As String       'Répertoire
Dim wbk As Workbook     'Fichier source
Dim wsh As Worksheet    'Feuille destination
Dim rng As Range        'Plage des données
Dim p°L As Long         'Première ligne
Dim d°L As Long         'Dernière ligne

rep = "M:\ROY\Inscriptions scolaires\Préparation inscription\Rentrée 2015\Tableaux inscriptions scolaires\"
Set wsh = Workbooks("Recap.xlsm").Worksheets("Feuil1")
wsh.Rows("3:" & wsh.Rows.Count).Clear

'ouverture dossier Karine
p°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row + 1
Set wbk = Workbooks.Open(rep & "Karine.xlsx")
Set rng = wbk.Worksheets(1).Range("A3").CurrentRegion.EntireRow
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
rng.Copy wsh.Range("A" & p°L)
d°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row
'affichage du nom du fichier dans la colonne S
wsh.Range("S" & p°L & ":S" & d°L) = wbk.Name
wbk.Close

'ouverture dossier Valerie
p°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row + 1
Set wbk = Workbooks.Open(rep & "Valerie.xlsx")
Set rng = wbk.Worksheets(1).Range("A3").CurrentRegion.EntireRow
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
rng.Copy wsh.Range("A" & p°L)
d°L = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row
'affichage du nom du fichier dans la colonne S
wsh.Range("S" & p°L & ":S" & d°L) = wbk.Name
wbk.Close

End Sub
    0
    1. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 785
       
      Au lieu de répondre dans le 1° post, réponds le post celui qui correspond, sinon on ne s'y retrouve plus !!!

      Sans ton fichier c'est pas simple.
      Y aurait-il 2 lignes de titres ? ou des cellules fusionnées ?
      Si il y a 2 lignes de titres, remplaces 
      Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
      par 
      Set rng = rng.Offset(2).Resize(rng.Rows.Count - 2)
      .

      Par contre si le tableau commence à la ligne 2 il faudra un autre code !

      Patrice
      0