Enregistrer un nouveau classeur avec données tableau filtré

Le 17/02/2014 à 10:25

Bonjour,

j'ai un tableau sur la feuille 1 (10 000 lignes) la colonne C, contient le nom de 60 communes.

Je souhaiterais enregistrer le nombre de ligne par commune dans un classeur différent. en gros je veux me retrouver avec 60 fichiers excel, soit 1 par commune.

1 - est-ce possible manuellement? je n'arrive pas a enregistrer seulement les données filtrés?

2 - Une macro serait vraiment cool . en gros sur la feuille 2 j'ai la liste des 60 communes, et faire une macro qui boucle sur la liste de mes communes et si Feuille2!A1 = nom de la commune, extrait le tout, enregistre dans un nouveau classeur et le nom de classeur = nom de la commune en colonne C.

est-ce possible?

Je ne connais pas le VBA, mais je connais le JS et autre langage web.

merci de votre aide !

Le 17/02/2014 à 10:34

Simple:

Devrait marcher

Sub toto
dim i as integer, j as long, k as long
For i = 1 to 60
Set NewBook = Workbooks.Add
    With NewBook
        .SaveAs Filename:=cstr(thisworkbook.Sheets("Feuille2").cells(i,1))&".xls"
    End With
'création nouveau classeur
k = 1
For j = 1 to thisworkbook.Sheets("Feuille1").range("C" & thisworkbook.Sheets("Feuille1").rows.count).end(xlup).row
If thisworkbook.Sheets("Feuille1").cells(j,3) = thisworkbook.Sheets("Feuille2").cells(i,1) then
thisworkbook.Sheets("Feuille1").cells(j,3).entirerow.copy Destination:=NewBook.Sheets(1).Range("A" & k)
k = k+1
end if
next j
NewBook.save
newbook.close
next i
end sub
Le 17/02/2014 à 10:57

Bonjour,

et merci de cette réponse rapide.

Alors les classeurs sont bien créés avec le nom de la commune, mais ils sont vide.

J'apporte des précisions :

feuille_1 s'appelle listing

feuille-2 s'appelle liste_commune

nombre de colonne du tableau de A à AB = 28

Nom de la commune colonne B

59 communes

voici donc comment je l'ai adapté :

Sub toto
dim i as integer, j as long, k as long
For i = 1 to 59
Set NewBook = Workbooks.Add
    With NewBook
        .SaveAs Filename:=cstr(thisworkbook.Sheets("liste_commune").cells(i,1))&".xlsx"
    End With
'création nouveau classeur
k = 1
For j = 1 to thisworkbook.Sheets("listing").range("B" & thisworkbook.Sheets("listing").rows.count).end(xlup).row
If thisworkbook.Sheets("listing").cells(j,3) = thisworkbook.Sheets("liste_commune").cells(i,1) then
thisworkbook.Sheets("listing").cells(j,3).entirerow.copy Destination:=NewBook.Sheets(1).Range("A" & k)
k = k+1
end if
next j
NewBook.save
newbook.close
next i
end sub

si je comprend bien, la variable J détermine le nombre de ligne et le k le nombre de colonne?

Merci de ton aide!

EDIT : Je viens de m'apercevoir, que j'ai changé le nom de la colonne mais pas le numéro dans la condition (j,3) en fait c'est (j,2) car colonne B.

Cela fonctionne parfaitement

un grand merci

Le 17/02/2014 à 11:03

Tu avais dit que tes communes étaient en C

Sub toto
dim i as integer, j as long, k as long
For i = 1 to 59
Set NewBook = Workbooks.Add
    With NewBook
        .SaveAs Filename:=cstr(thisworkbook.Sheets("liste_commune").cells(i,1))&".xlsx"
    End With
'création nouveau classeur
k = 1
For j = 1 to thisworkbook.Sheets("listing").range("B" & thisworkbook.Sheets("listing").rows.count).end(xlup).row
If thisworkbook.Sheets("listing").cells(j,2) = thisworkbook.Sheets("liste_commune").cells(i,1) then
thisworkbook.Sheets("listing").cells(j,1).entirerow.copy Destination:=NewBook.Sheets(1).Range("A" & k)
k = k+1
end if
next j
NewBook.save
newbook.close
next i
end sub
Le 17/02/2014 à 11:06

on a poster en même temps, je m'en suis aperçu! un poil trop tard on dirait!!

autre question, maintenant dans ce classeur par commune que je viens de créer, je souhaite faire la même chose extraire dans un nouveau classeur, toutes les lignes qui sont en jaune est-ce possible?

Un grand merci, tu viens de me faire gagner un temps précieux!

Le 17/02/2014 à 11:12
Sub toto
dim i as integer, j as long, k as long, l as long, m as long
For i = 1 to 59
Set NewBook = Workbooks.Add
    With NewBook
        .SaveAs Filename:=cstr(thisworkbook.Sheets("liste_commune").cells(i,1))&".xlsx"
    End With
'création nouveau classeur
k = 1
For j = 1 to thisworkbook.Sheets("listing").range("B" & thisworkbook.Sheets("listing").rows.count).end(xlup).row
If thisworkbook.Sheets("listing").cells(j,2) = thisworkbook.Sheets("liste_commune").cells(i,1) then
thisworkbook.Sheets("listing").cells(j,1).entirerow.copy Destination:=NewBook.Sheets(1).Range("A" & k)
k = k+1
end if
next j
NewBook.save
Set NewBook2 = Workbooks.Add
    With NewBook2
        .SaveAs Filename:=cstr(thisworkbook.Sheets("liste_commune").cells(i,1))& "lignesjaunes.xlsx"
    End With
m=2
For l = 1 to Newbook.sheets(1).range("A" & Newbook.sheets(1).rows.count).end(xlup).row
if Newbook.sheets(1).range("A" & l).interior.color = RGB(100,100,100) then
Newbook.sheets(1).range("A" & l).entirerow.copy destination:=NewBook2.Sheets(1).Range("A" & m)
m=m+1
end if
next l
newbook2.save
newbook2.close
newbook.close
next i
end sub

Modifie le RGB vers la couleur de ton choix

Pour info:

Le jaune classique excel 2010 vaut RGB(255,255,0)

Le 17/02/2014 à 12:00

Ok!

merci à toi

tout fonctionne à merveille!

sujet résolu!

Le 24/02/2014 à 10:02

Bonjour,

je remonte le sujet car j'ai oublié une petite chose dans cette macro, je voudrais que le nouveau classeur généré comporte mes entetes de colonne, soit la premiere ligne.

a partir de cette macro :

Sub toto
dim i as integer, j as long, k as long
For i = 1 to 60
Set NewBook = Workbooks.Add
    With NewBook
        .SaveAs Filename:=cstr(thisworkbook.Sheets("Feuille2").cells(i,1))&".xls"
    End With
'création nouveau classeur
k = 1
For j = 1 to thisworkbook.Sheets("Feuille1").range("C" & thisworkbook.Sheets("Feuille1").rows.count).end(xlup).row
If thisworkbook.Sheets("Feuille1").cells(j,3) = thisworkbook.Sheets("Feuille2").cells(i,1) then
thisworkbook.Sheets("Feuille1").cells(j,3).entirerow.copy Destination:=NewBook.Sheets(1).Range("A" & k)
k = k+1
end if
next j
NewBook.save
newbook.close
next i
end sub

j'ai essayé d'arranger le code notamment en rajoutant cette ligne :

thisworkbook.Sheets("Feuille1").cells(1,1).entirerow.copy Destination:=NewBook.Sheets(1).Range(A,1)

mais je n'y arrive pas,

si quelqu'un pourrais m'aider.

Merci

Le 24/02/2014 à 10:21

Si mes souvenirs sont bons...

Sub toto
dim i as integer, j as long, k as long
For i = 1 to 60
Set NewBook = Workbooks.Add
    With NewBook
        .SaveAs Filename:=cstr(thisworkbook.Sheets("Feuille2").cells(i,1))&".xls"
    End With
'création nouveau classeur
thisworkbook.Sheets("Feuille1").cells(1,1).entirerow.copy Destination:=NewBook.Sheets(1).Range("A" & 1)
k = 2
For j = 2 to thisworkbook.Sheets("Feuille1").range("C" & thisworkbook.Sheets("Feuille1").rows.count).end(xlup).row
If thisworkbook.Sheets("Feuille1").cells(j,3) = thisworkbook.Sheets("Feuille2").cells(i,1) then
thisworkbook.Sheets("Feuille1").cells(j,3).entirerow.copy Destination:=NewBook.Sheets(1).Range("A" & k)
k = k+1
end if
next j
NewBook.save
newbook.close
next i
end sub
Le 24/02/2014 à 10:44

merci de cette réponse rapide,

déjà voici ma macro que j'ai adapté à une nouvelle demande mais le principe est bien le même

Sub toto()
Dim i As Integer, j As Long, k As Long
For i = 1 To 36
Set newbook = Workbooks.Add
    With newbook
        .SaveAs Filename:=CStr(ThisWorkbook.Sheets("liste_armoire").Cells(i, 1)) & ".xlsx"
    End With
'création nouveau classeur
ThisWorkbook.Sheets("foyer").Cells(1, 1).EntireRow.Copy Destination:=newbook.Sheets(1).Range("A" & 1)
'copie en-tete colonne
k = 2
For j = 2 To ThisWorkbook.Sheets("foyer").Range("C" & ThisWorkbook.Sheets("foyer").Rows.Count).End(xlUp).Row
If ThisWorkbook.Sheets("foyer").Cells(j, 3) = ThisWorkbook.Sheets("liste_armoire").Cells(i, 1) Then
ThisWorkbook.Sheets("liste_armoire").Cells(j, 3).EntireRow.Copy Destination:=newbook.Sheets(1).Range("A" & k)
k = k + 1
End If
Next j
newbook.Save
newbook.Close
Next i
End Sub

Cette macro ne fonctionne pas :

J'ai bien l'ensemble de mes nouveaux classeurs avec le bon nom de créés

J'ai bien la première ligne contenant mes entetes dans chaque classeurs

Mais je n'ai pas le contenu.

Par contre quand je lance la macro, elle s'exécute parfaitement sans message d'erreur, je vois bien que le contenu est récupéré et collé dans un nouveau classeur mais ce nouveau classeur ne porte pas le nom de la cellule comme celui précédemment crée. Les valeurs copiées sont déplacé dans un classeur au nom générique du style classeur0120 (je voie cette info défiler en haut rapidement)

impossible de retrouver se classeur par la suite

une idée?

EDIT : vraiment désolé je me suis trompé de nom de feuille :

ThisWorkbook.Sheets("liste_armoire").Cells(j, 3).EntireRow.Copy Destination:=newbook.Sheets(1).Range("A" & k)

j'ai mis le nom de la deuxieme au lieu de la premiere!

tout fonctionne merci bien!!

par contre peut faire le copier/coller des en-tetes dans le nouveau classeur avec le respect des largeurs de colonne?

Merci beaucoup!!

Le 24/02/2014 à 10:49

Vérifié la macro que je t'ai donné marche. Adapte la bien avant de dire que cela ne marche pas. L'erreur vient souvent de celui qui pense être un expert alors qu'il n'assimile même pas les bases.

Le 24/02/2014 à 10:51

Oui oui,

j'ai édité mon poste, cela fonctionne!

est-il possible de faire ce systeme de copier/coller en respectant la largeur des colonnes du document initial?

et j'ai compris le principe mais j'ai besoin de la syntaxe pour ajouter un champ en tete de page, comment faire?

merci

Le 24/02/2014 à 10:53

cherche dans les propriétés de cells ou de range. Tu dois avoir un width il suffira d'affecter à la nouvelle colonne le width de l'ancienne.

Rechercher des sujets similaires à "enregistrer nouveau classeur donnees tableau filtre"