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
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
A voir également:
- Qupprimer des lignes vides d'un tableau créer en VBA
- Créer un compte gmail - Guide
- Créer un compte google - Guide
- Créer un compte instagram - Guide
- Créer un compte facebook - Guide
- Creer adresse mail - Guide
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
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
Décaler toi un peu, j'arrive pas à voir ton écran et aujourd'hui ma boule de cristal reste opaque !
Patrice
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
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
En attendant la boule de cristal, un exemple pour supprimer les lignes vides
https://www.cjoint.com/?3Dvs3I69WWl
Michel
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
22 avril 2015 à 17:17
Bonjour,
Essaies :
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
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
23 avril 2015 à 12:44
Bonjour,
Désolé, j'ai été un peu trop rapide,
Remplace
et
par
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
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
23 avril 2015 à 16:48
Re,
Essaies :
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
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 762
24 avril 2015 à 09:57
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
Par contre si le tableau commence à la ligne 2 il faudra un autre code !
Patrice
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
22 avril 2015 à 15:29
'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.
23 avril 2015 à 12:03
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.
23 avril 2015 à 14:11
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
24 avril 2015 à 09:22
Merci de ton aide