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 8561 Date d'inscription Statut Membre Dernière intervention - 24 avril 2015 à 09:57

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

A voir également:

Qupprimer des lignes vides d'un tableau créer en VBA
Créer un lien pour partager des photos - Guide
Créer un compte google - Guide
Comment créer un groupe whatsapp - Guide
Tableau word - Guide
Trier un tableau excel - Guide

5 réponses

Réponse 1 / 5

Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention 1 780

Bonjour

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

Patrice

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.

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.

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

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

Réponse 2 / 5

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 313

Bonjour

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

Michel

Réponse 3 / 5

Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention 1 780

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

Réponse 4 / 5

Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention 1 780

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

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

par

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

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

Posez votre question

Réponse 5 / 5

Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention 1 780

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

Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention 1 780

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

Votre réponse