Menu

Synthétiser des tableaux en 1 seul

buggy45 9 Messages postés mardi 21 avril 2015Date d'inscription 14 avril 2018 Dernière intervention - 11 avril 2018 à 14:59 - Dernière réponse : yg_be 6040 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 22 juillet 2018 Dernière intervention
- 17 avril 2018 à 17:02
Bonjour,
J'ai 6 tableaux dans 6 fichiers différents (même ligne de titres) je dois mettre les données dans 1 seul tableau RECAP.xlsm.
Dans la dernière colonne (W3) de mon tableau RECAP je dois inscrire le nom du fichier d'où proviennent les données.
Mon code est: Range("W3:W"& ActiveSheet.UsedRange.Rows.Count )="Karine"
Mais dans la colonne W, j'ai 1000 lignes avec "Karine"
Comment faire, je ne trouve pas de solution.
Le fichier Karine est le premier des 6.
merci de votre aide
Afficher la suite 

Votre réponse

22 réponses

yg_be 6040 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 22 juillet 2018 Dernière intervention - 11 avril 2018 à 20:57
0
Merci
bonsoir, tu n'as qu'une seule ligne de code?
Bonsoir,
Non j'ai plusieurs lignes de code, mais il me semble que c'est celle-là qui ne fonctionne pas.

Je vous joints le début de mon code:

' supprimer la page sauf la 1er ligne
Sub DeleteExceptFirst()
Rows("2:" & Rows.Count).ClearContents
'Gras

Range("A2:W2").Font.Bold = True
' Ecriture des titres :
Range("A2") = "Date du Jour"
Range("B2") = "Nom de l'Enfant"
Range("C2") = "Prénom de l'Enfant"
Range("D2") = "Date de naissance de l'Enfant"
Range("E2") = "Civilité du responsable"
Range("F2") = "Nom du responsable"
Range("G2") = "Prénom du responsable"
Range("H2") = "Adresse"
Range("I2") = "Code postal"
Range("J2") = "Commune"
Range("K2") = "Catégorie"
Range("L2") = "Commune précédente"
Range("M2") = "Justificatif Domicile"
Range("N2") = "Numéro d'inscription"
Range("O2") = "Ecole Maternelle de Secteur"
Range("P2") = "Ecole Primaire de Secteur"
Range("Q2") = "Souhait de dérogation maternelle "
Range("R2") = "Souhait de dérogation élémentaire"
Range("S2") = "Motif de la dérogation"
Range("T2") = "Décision de la commission"
Range("U2") = "Frais de scolarité"
Range("V2") = "Observations"
'ouverture dossier karine:
Workbooks.Open "M:\ROY\Inscriptions scolaires\Préparation inscription\Rentrée 2018\Tableaux inscriptions scolaires\Karine.xlsx"
AvantDerniereLigne = ActiveSheet.UsedRange.Rows.Count + 1
Workbooks("Karine.xlsx").Sheets("Feuil1").Range("A3:V" & AvantDerniereLigne).Copy
Workbooks("Recap ESSAI.xlsm").Activate
Workbooks("Recap ESSAI.xlsm").Sheets("INSCRIPTIONS").Range("A3").Select
Workbooks("Recap ESSAI.xlsm").Sheets("INSCRIPTIONS").Paste
Range("W3:W" & ActiveSheet.UsedRange.Rows.Count + 1) = "Karine.xlsx"
'fermeture du dossier Karine:
Workbooks("Karine.xlsx").Close

'Ouverture du dossier valérie:
Workbooks.Open "M:\ROY\Inscriptions scolaires\Préparation inscription\Rentrée 2018\Tableaux inscriptions scolaires\Valérie.xlsx"
AvantDerniereLigne = ActiveSheet.UsedRange.Rows.Count + 1
Workbooks("Valérie.xlsx").Sheets("Feuil1").Range("A3:V" & AvantDerniereLigne).Copy
Workbooks("Recap ESSAI.xlsm").Activate
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
Workbooks("Recap ESSAI.xlsm").Sheets("INSCRIPTIONS").Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
Workbooks("Recap ESSAI.xlsm").Sheets("INSCRIPTIONS").Paste
ActiveSheet.Range("W" & DebutNomFichier & ":W" & ActiveSheet.UsedRange.Rows.Count) = "Valérie"
Application.CutCopyMode = False
Workbooks("Valérie.xlsx").Close

Même code pour les 4 fichiers suivants.


Merci de votre aide
yg_be 6040 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 22 juillet 2018 Dernière intervention - 12 avril 2018 à 14:10
veux-tu dire que l'instruction suivante ne fait rien?
ActiveSheet.Range("W" & DebutNomFichier & ":W" & ActiveSheet.UsedRange.Rows.Count) = "Valérie"
Je ne comprends pas ta question.
Ma demande : je souhaite que le tableau recap où sont rapatriées toutes les données des autres tableaux me mettent dans la colonne W le nom du fichier d'où elles proviennent.
Ainsi concernant le fichier karine, dans la colonne W de mon tableau RECAP, j'ai 1000 "karine" alors que je n'ai rapatrié aucune données, vu qu'à ce moment là je n'e'n avais pas encore, le tableau du fichier Karine étant vide
merci
il me semble que le problème se pose sur la ligne:
Range("W3:W" & ActiveSheet.UsedRange.Rows.Count + 1) = "Karine.xlsx"
qui me met en colonne W 1000 lignes de "Karine"
Merci
Commenter la réponse de yg_be
yg_be 6040 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 22 juillet 2018 Dernière intervention - Modifié par yg_be le 12/04/2018 à 16:52
0
Merci
moi je commencerais pas assainir le code et supprimer tous les select et activate.
Option Explicit

' supprimer la page sauf la 1er ligne
Sub DeleteExceptFirst()
Dim cl_classe As Workbook
Dim f_classe As Worksheet, f_recap As Worksheet
Dim AvantDerniereLigne  As Long, DebutNomFichier As Long

Set f_recap = ThisWorkbook.Sheets("INSCRIPTIONS")
f_recap.Rows("2:" & Rows.Count).ClearContents
'Gras

f_recap.Range("A2:W2").Font.Bold = True
' Ecriture des titres :
f_recap.Range("A2") = "Date du Jour"
f_recap.Range("B2") = "Nom de l'Enfant"
f_recap.Range("C2") = "Prénom de l'Enfant"
f_recap.Range("D2") = "Date de naissance de l'Enfant"
f_recap.Range("E2") = "Civilité du responsable"
f_recap.Range("F2") = "Nom du responsable"
f_recap.Range("G2") = "Prénom du responsable"
f_recap.Range("H2") = "Adresse"
f_recap.Range("I2") = "Code postal"
f_recap.Range("J2") = "Commune"
f_recap.Range("K2") = "Catégorie"
f_recap.Range("L2") = "Commune précédente"
f_recap.Range("M2") = "Justificatif Domicile"
f_recap.Range("N2") = "Numéro d'inscription"
f_recap.Range("O2") = "Ecole Maternelle de Secteur"
f_recap.Range("P2") = "Ecole Primaire de Secteur"
f_recap.Range("Q2") = "Souhait de dérogation maternelle "
f_recap.Range("R2") = "Souhait de dérogation élémentaire"
f_recap.Range("S2") = "Motif de la dérogation"
f_recap.Range("T2") = "Décision de la commission"
f_recap.Range("U2") = "Frais de scolarité"
f_recap.Range("V2") = "Observations"

'ouverture dossier karine:
Set cl_classe = Workbooks.Open _
    ("M:\ROY\Inscriptions scolaires\Préparation inscription\Rentrée 2018\Tableaux inscriptions scolaires\Karine.xlsx")
Set f_classe = cl_classe.Sheets("Feuil1")
AvantDerniereLigne = f_classe.UsedRange.Rows.Count + 1
f_classe.Range("A3:V" & AvantDerniereLigne).copy destination:=f_recap.Range("A3")
f_recap.Range("W3:W" & f_recap.UsedRange.Rows.Count + 1) = "Karine.xlsx"
'fermeture du dossier Karine:
cl_classe.Close

'Ouverture du dossier valérie:
Set cl_classe = Workbooks.Open _
    ("M:\ROY\Inscriptions scolaires\Préparation inscription\Rentrée 2018\Tableaux inscriptions scolaires\Valérie.xlsx")
Set f_classe = cl_classe.Sheets("Feuil1")
AvantDerniereLigne = f_classe.UsedRange.Rows.Count + 1
DebutNomFichier = f_recap.UsedRange.Rows.Count + 1
f_classe.Range("A3:V" & AvantDerniereLigne).copy destination:=f_recap.Range("A" & DebutNomFichier)
f_recap.Range("W" & DebutNomFichier & ":W" & f_recap.UsedRange.Rows.Count) = "Valérie"
cl_classe.Close

'...

End Sub
Rebonjour,
Cela va beaucoup mieux. Au lieu d'avoir 1000lignes de karine il m'en reste 2, et le dossier valerie se positionne après ces 2 lignes.
Peux-tu améliorer ma macro? Sinon je supprimerai ces 2 lignes manuellement
merci
je viens de tester ma macro complètement et entre les différents rapatriements des données des fichiers , s'insèrent des lignes blanches avec dans la colonne W le nom du fichier d'où sont issues les données.
Je pense qu'il faudrait un code à la fin de la macro qui supprime toutes les lignes de mon fichier RECAP dont les colonnes sont vides de A à V .
merci
yg_be 6040 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 22 juillet 2018 Dernière intervention > Buggy - 17 avril 2018 à 15:34
moi je commencerais par supprimer le +1 dans la ligne:
f_recap.Range("W3:W" & f_recap.UsedRange.Rows.Count + 1) = "Karine.xlsx"
et, mieux, de faire plutôt:
f_recap.Range("W3:W" & f_recap.UsedRange.Rows(f_recap.UsedRange.Rows.Count).Row) = _
     cl_classe.Name

ensuite, si tu cherches réellement l'avant dernière ligne:
AvantDerniereLigne = f_classe.UsedRange.Rows(f_classe.UsedRange.Rows.Count).Row -1
Dans la ligne
f_recap.Range("W3:W" & f_recap.UsedRange.Rows.Count + 1) = "Karine.xlsx",
J'ai mis +1 pour que les données de karine s'insèrent juste après ma ligne de titres en A2
Ensuite je ne cherche pas nécessairement l'AvantDernièreLigne , mais je veux par exemple que les données issues du dossier valérie se positionnent juste au dessous des données de karine et ainsi de suite pour les autres dossiers.
Peut-être que AvantDernièreLigne n'est pas nécessaire. Ce serait plutôt dernière ligne.
Je vais quand même essayer ce que tu m'as dit.
yg_be 6040 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 22 juillet 2018 Dernière intervention > Buggy - 17 avril 2018 à 17:02
suggestion:
Option Explicit

' supprimer la page sauf la 1er ligne
Sub DeleteExceptFirst()
Dim cl_classe As Workbook
Dim f_classe As Worksheet, f_recap As Worksheet
Dim AvantDerniereLigne  As Long, DebutNomFichier As Long

Set f_recap = ThisWorkbook.Sheets("INSCRIPTIONS")
f_recap.Rows("2:" & Rows.Count).Clear
'Gras
f_recap.Range("A2:W2").Font.Bold = True
' Ecriture des titres :
f_recap.Range("A2") = "Date du Jour"
f_recap.Range("B2") = "Nom de l'Enfant"
f_recap.Range("C2") = "Prénom de l'Enfant"
f_recap.Range("D2") = "Date de naissance de l'Enfant"
f_recap.Range("E2") = "Civilité du responsable"
f_recap.Range("F2") = "Nom du responsable"
f_recap.Range("G2") = "Prénom du responsable"
f_recap.Range("H2") = "Adresse"
f_recap.Range("I2") = "Code postal"
f_recap.Range("J2") = "Commune"
f_recap.Range("K2") = "Catégorie"
f_recap.Range("L2") = "Commune précédente"
f_recap.Range("M2") = "Justificatif Domicile"
f_recap.Range("N2") = "Numéro d'inscription"
f_recap.Range("O2") = "Ecole Maternelle de Secteur"
f_recap.Range("P2") = "Ecole Primaire de Secteur"
f_recap.Range("Q2") = "Souhait de dérogation maternelle "
f_recap.Range("R2") = "Souhait de dérogation élémentaire"
f_recap.Range("S2") = "Motif de la dérogation"
f_recap.Range("T2") = "Décision de la commission"
f_recap.Range("U2") = "Frais de scolarité"
f_recap.Range("V2") = "Observations"

Call import_classe("Karine", f_recap)
Call import_classe("Valérie", f_recap)

'...

End Sub

Sub import_classe(classe As String, f_recap As Worksheet)
Dim cl_classe As Workbook
Dim f_classe As Worksheet
Dim DerniereLigne  As Long, DebutNomFichier As Long
Set cl_classe = Workbooks.Open _
    ("M:\ROY\Inscriptions scolaires\Préparation inscription\Rentrée 2018\Tableaux inscriptions scolaires\" & classe & ".xlsx")
Set f_classe = cl_classe.Sheets("Feuil1")
DerniereLigne = f_classe.UsedRange.Rows(f_classe.UsedRange.Rows.Count).Row
DebutNomFichier = f_recap.UsedRange.Rows(f_recap.UsedRange.Rows.Count).Row + 1
f_classe.Range("A3:V" & DerniereLigne).Copy Destination:=f_recap.Range("A" & DebutNomFichier)
f_recap.Range("W" & DebutNomFichier & ":W" & f_recap.UsedRange.Rows.Count) = classe
cl_classe.Close
End Sub
Commenter la réponse de yg_be