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

Fermé
buggy45 Messages postés 9 Date d'inscription mardi 21 avril 2015 Statut Membre Dernière intervention 14 avril 2018 - 21 avril 2015 à 16:53
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 - 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:

5 réponses

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 762
21 avril 2015 à 17:37
Bonjour

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

Patrice
1
buggy45 Messages postés 9 Date d'inscription mardi 21 avril 2015 Statut Membre Dernière intervention 14 avril 2018
22 avril 2015 à 15:29
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
buggy45 > buggy45 Messages postés 9 Date d'inscription mardi 21 avril 2015 Statut Membre Dernière intervention 14 avril 2018
23 avril 2015 à 12:03
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
buggy45 > buggy45
23 avril 2015 à 14:11
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
buggy45 > buggy45
24 avril 2015 à 09:22
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
michel_m Messages postés 16593 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 7 mars 2023 3 291
Modifié par michel_m le 21/04/2015 à 18:42
Bonjour

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

Michel
1
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 762
22 avril 2015 à 17:17
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
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 762
23 avril 2015 à 12:44
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

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

Posez votre question
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 762
23 avril 2015 à 16:48
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
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 762
24 avril 2015 à 09:57
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