Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel découper une feuille de calcul

découper une feuille de calcul

23 réponses
Avatar
MCA
Bonjour,
Voilà j'ai une feuille de calcul avec beaucoup de lignes. J'ai plusieurs
lignes avec le meme code dans une colonne (A par exemple). J'aimerais
découper cette feuille en plusieurs fichiers à chaque fois que le code change
dans la colonne A.
Est-ce possible ?
Merci de vos réponses.
--
MCA
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3
Avatar
Daniel
Bonjour.
Essaie le code suivant :

Sub test()
Dim Res As String, c As Range, Plage As Range, Ligne As Long
Ligne = 1
Res = [A1]
Set Plage = Range("A1", Range("A65536").End(xlUp))
Workbooks.Add
For Each c In Plage
If c.Value = Res Then
c.EntireRow.Copy ActiveSheet.Range("A" & Ligne)
Ligne = Ligne + 1
Else
ActiveWorkbook.SaveAs Res & ".xls"
ActiveWorkbook.Close
Res = c.Value
Ligne = 1
Workbooks.Add
End If
Next c
ActiveWorkbook.SaveAs Res & ".xls"
ActiveWorkbook.Close
End Sub

Cordialement.
Daniel
"MCA" a écrit dans le message de news:

Bonjour,
Voilà j'ai une feuille de calcul avec beaucoup de lignes. J'ai plusieurs
lignes avec le meme code dans une colonne (A par exemple). J'aimerais
découper cette feuille en plusieurs fichiers à chaque fois que le code
change
dans la colonne A.
Est-ce possible ?
Merci de vos réponses.
--
MCA


Avatar
michdenis
Bonjour MCA,

Essaie ceci :

Fait une sauvegarde de ton classeur.
Celui que tu utiliseras pour le "Découpage" se retrouvera
vide de ses données à la fin de l'opération.

'------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
Set Sh = Worksheets("Feuil1") 'Nom feuille à déterminer

With Sh
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Range("_FilterDataBase") _
.SpecialCells(xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Wk.Close False

Set Wk = Nothing: Set Sh = Nothing

End Sub
'-----------------------------------------


Salutations!



"MCA" a écrit dans le message de news:
Bonjour,
Voilà j'ai une feuille de calcul avec beaucoup de lignes. J'ai plusieurs
lignes avec le meme code dans une colonne (A par exemple). J'aimerais
découper cette feuille en plusieurs fichiers à chaque fois que le code change
dans la colonne A.
Est-ce possible ?
Merci de vos réponses.
--
MCA
Avatar
JLuc
*Bonjour Daniel*,
Une petite modif semble de mise...

Bonjour.
Essaie le code suivant :

Sub test()
Dim Res As String, c As Range, Plage As Range, Ligne As Long
Ligne = 1
Res = [A1]
Set Plage = Range("A1", Range("A65536").End(xlUp))
Workbooks.Add
For Each c In Plage
If c.Value = Res Then
c.EntireRow.Copy ActiveSheet.Range("A" & Ligne)
Ligne = Ligne + 1
Else
ActiveWorkbook.SaveAs Res & ".xls"
ActiveWorkbook.Close
Res = c.Value
Ligne = 1
Workbooks.Add


c.EntireRow.Copy ActiveSheet.Range("A" & Ligne)
Ligne = Ligne + 1

End If
Next c
ActiveWorkbook.SaveAs Res & ".xls"
ActiveWorkbook.Close
End Sub

Cordialement.
Daniel
"MCA" a écrit dans le message de news:

Bonjour,
Voilà j'ai une feuille de calcul avec beaucoup de lignes. J'ai plusieurs
lignes avec le meme code dans une colonne (A par exemple). J'aimerais
découper cette feuille en plusieurs fichiers à chaque fois que le code
change
dans la colonne A.
Est-ce possible ?
Merci de vos réponses.
-- MCA




--
JLuc

Pensez a regarder ces sites très bien fait, ce sont des mines de trucs
et astuces !
http://www.excelabo.net
http://jacxl.free.fr/
http://dj.joss.free.fr/
C:Program FilesMicrosoft OfficeOffice1036VBALIST.XLS


Avatar
JLuc
*Bonjour michdenis*,
A quoi correspond la valeur negative dans :
Set Wk = Workbooks.Add(-4167)
C'est la valeur d'une des constantes possible pour le parametre
"Template" de la commande Add ?
Ou trouver ces constantes avec leurs valeurs numeriques ?
Bonjour MCA,

Essaie ceci :

Fait une sauvegarde de ton classeur.
Celui que tu utiliseras pour le "Découpage" se retrouvera
vide de ses données à la fin de l'opération.

'------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
Set Sh = Worksheets("Feuil1") 'Nom feuille à déterminer

With Sh
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Range("_FilterDataBase") _
.SpecialCells(xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Wk.Close False

Set Wk = Nothing: Set Sh = Nothing

End Sub
'-----------------------------------------


Salutations!



"MCA" a écrit dans le message de news:
Bonjour,
Voilà j'ai une feuille de calcul avec beaucoup de lignes. J'ai plusieurs
lignes avec le meme code dans une colonne (A par exemple). J'aimerais
découper cette feuille en plusieurs fichiers à chaque fois que le code change
dans la colonne A.
Est-ce possible ?
Merci de vos réponses.



--
JLuc

Pensez a regarder ces sites très bien fait, ce sont des mines de trucs
et astuces !
http://www.excelabo.net
http://jacxl.free.fr/
http://dj.joss.free.fr/
C:Program FilesMicrosoft OfficeOffice1036VBALIST.XLS

Avatar
michdenis
Bonjour JLuc,

| Workbooks.Add -4167

Ceci te permet de créer un classeur n'ayant qu'une
seule feuille et ce nonobstant le nombre de feuille
défini dans :
menu / outils / options / Onglet Général.

C'est plus rapide que d'ajouter simplement un classeur
et de supprimer toutes les feuilles non désirées à la fin
de la procédure !


Salutations!




"JLuc" a écrit dans le message de news:
*Bonjour michdenis*,
A quoi correspond la valeur negative dans :
Set Wk = Workbooks.Add(-4167)
C'est la valeur d'une des constantes possible pour le parametre
"Template" de la commande Add ?
Ou trouver ces constantes avec leurs valeurs numeriques ?
Bonjour MCA,

Essaie ceci :

Fait une sauvegarde de ton classeur.
Celui que tu utiliseras pour le "Découpage" se retrouvera
vide de ses données à la fin de l'opération.

'------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
Set Sh = Worksheets("Feuil1") 'Nom feuille à déterminer

With Sh
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Range("_FilterDataBase") _
.SpecialCells(xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Wk.Close False

Set Wk = Nothing: Set Sh = Nothing

End Sub
'-----------------------------------------


Salutations!



"MCA" a écrit dans le message de news:
Bonjour,
Voilà j'ai une feuille de calcul avec beaucoup de lignes. J'ai plusieurs
lignes avec le meme code dans une colonne (A par exemple). J'aimerais
découper cette feuille en plusieurs fichiers à chaque fois que le code change
dans la colonne A.
Est-ce possible ?
Merci de vos réponses.



--
JLuc

Pensez a regarder ces sites très bien fait, ce sont des mines de trucs
et astuces !
http://www.excelabo.net
http://jacxl.free.fr/
http://dj.joss.free.fr/
C:Program FilesMicrosoft OfficeOffice1036VBALIST.XLS

Avatar
Daniel
Nul n'est parfait...
Daniel
"JLuc" a écrit dans le message de news:

*Bonjour Daniel*,
Une petite modif semble de mise...

Bonjour.
Essaie le code suivant :

Sub test()
Dim Res As String, c As Range, Plage As Range, Ligne As Long
Ligne = 1
Res = [A1]
Set Plage = Range("A1", Range("A65536").End(xlUp))
Workbooks.Add
For Each c In Plage
If c.Value = Res Then
c.EntireRow.Copy ActiveSheet.Range("A" & Ligne)
Ligne = Ligne + 1
Else
ActiveWorkbook.SaveAs Res & ".xls"
ActiveWorkbook.Close
Res = c.Value
Ligne = 1
Workbooks.Add


c.EntireRow.Copy ActiveSheet.Range("A" & Ligne)
Ligne = Ligne + 1

End If
Next c
ActiveWorkbook.SaveAs Res & ".xls"
ActiveWorkbook.Close
End Sub

Cordialement.
Daniel
"MCA" a écrit dans le message de news:

Bonjour,
Voilà j'ai une feuille de calcul avec beaucoup de lignes. J'ai plusieurs
lignes avec le meme code dans une colonne (A par exemple). J'aimerais
découper cette feuille en plusieurs fichiers à chaque fois que le code
change
dans la colonne A.
Est-ce possible ?
Merci de vos réponses.
-- MCA




--
JLuc

Pensez a regarder ces sites très bien fait, ce sont des mines de trucs et
astuces !
http://www.excelabo.net
http://jacxl.free.fr/
http://dj.joss.free.fr/
C:Program FilesMicrosoft OfficeOffice1036VBALIST.XLS






Avatar
JLuc
*Bonjour michdenis*,
C'est bien ce que je pensais avoir compris, mais d'ou tu sort la valeur
de -4167 ?
Bonjour JLuc,

Workbooks.Add -4167


Ceci te permet de créer un classeur n'ayant qu'une
seule feuille et ce nonobstant le nombre de feuille
défini dans :
menu / outils / options / Onglet Général.

C'est plus rapide que d'ajouter simplement un classeur
et de supprimer toutes les feuilles non désirées à la fin
de la procédure !


Salutations!




"JLuc" a écrit dans le message de news:
*Bonjour michdenis*,
A quoi correspond la valeur negative dans :
Set Wk = Workbooks.Add(-4167)
C'est la valeur d'une des constantes possible pour le parametre
"Template" de la commande Add ?
Ou trouver ces constantes avec leurs valeurs numeriques ?
Bonjour MCA,

Essaie ceci :

Fait une sauvegarde de ton classeur.
Celui que tu utiliseras pour le "Découpage" se retrouvera
vide de ses données à la fin de l'opération.

'------------------------------------
Sub Découper()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "C:"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "Denis"

'Où sont les données
Set Sh = Worksheets("Feuil1") 'Nom feuille à déterminer

With Sh
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
Set Wk = Workbooks.Add(-4167)

Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Range("_FilterDataBase") _
.SpecialCells(xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A1")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Cells.Clear
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Wk.Close False

Set Wk = Nothing: Set Sh = Nothing

End Sub
'-----------------------------------------


Salutations!



"MCA" a écrit dans le message de news:
Bonjour,
Voilà j'ai une feuille de calcul avec beaucoup de lignes. J'ai plusieurs
lignes avec le meme code dans une colonne (A par exemple). J'aimerais
découper cette feuille en plusieurs fichiers à chaque fois que le code
change dans la colonne A.
Est-ce possible ?
Merci de vos réponses.




--
JLuc

Pensez a regarder ces sites très bien fait, ce sont des mines de trucs
et astuces !
http://www.excelabo.net
http://jacxl.free.fr/
http://dj.joss.free.fr/
C:Program FilesMicrosoft OfficeOffice1036VBALIST.XLS


Avatar
JLuc
*Bonjour Daniel*,
Je suis d'accord avec toi, mais il fallait quand meme le preciser pour
ne pas avoir des manques dans ses données :oÞ
Nul n'est parfait...
Daniel
"JLuc" a écrit dans le message de news:

*Bonjour Daniel*,
Une petite modif semble de mise...

Bonjour.
Essaie le code suivant :

Sub test()
Dim Res As String, c As Range, Plage As Range, Ligne As Long
Ligne = 1
Res = [A1]
Set Plage = Range("A1", Range("A65536").End(xlUp))
Workbooks.Add
For Each c In Plage
If c.Value = Res Then
c.EntireRow.Copy ActiveSheet.Range("A" & Ligne)
Ligne = Ligne + 1
Else
ActiveWorkbook.SaveAs Res & ".xls"
ActiveWorkbook.Close
Res = c.Value
Ligne = 1
Workbooks.Add


c.EntireRow.Copy ActiveSheet.Range("A" & Ligne)
Ligne = Ligne + 1

End If
Next c
ActiveWorkbook.SaveAs Res & ".xls"
ActiveWorkbook.Close
End Sub

Cordialement.
Daniel
"MCA" a écrit dans le message de news:

Bonjour,
Voilà j'ai une feuille de calcul avec beaucoup de lignes. J'ai plusieurs
lignes avec le meme code dans une colonne (A par exemple). J'aimerais
découper cette feuille en plusieurs fichiers à chaque fois que le code
change
dans la colonne A.
Est-ce possible ?
Merci de vos réponses.
-- MCA




-- JLuc

Pensez a regarder ces sites très bien fait, ce sont des mines de trucs et
astuces !
http://www.excelabo.net
http://jacxl.free.fr/
http://dj.joss.free.fr/
C:Program FilesMicrosoft OfficeOffice1036VBALIST.XLS






--
JLuc

Pensez a regarder ces sites très bien fait, ce sont des mines de trucs
et astuces !
http://www.excelabo.net
http://jacxl.free.fr/
http://dj.joss.free.fr/
C:Program FilesMicrosoft OfficeOffice1036VBALIST.XLS




Avatar
Daniel
Ou trouver ces constantes avec leurs valeurs numeriques ?
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbaxl11/html/xlhowConstants_HV01049962.asp

Avec ça, tu passes pour un gourou !
;-)))
Daniel

Avatar
JLuc
*Bonjour Daniel*,
Merci pour l'info, dommage qu'ils ne precisent pas a quoi elles
correspondent ! :/
Ou trouver ces constantes avec leurs valeurs numeriques ?
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbaxl11/html/xlhowConstants_HV01049962.asp

Avec ça, tu passes pour un gourou !
;-)))
Daniel



--
JLuc

Pensez a regarder ces sites très bien fait, ce sont des mines de trucs
et astuces !
http://www.excelabo.net
http://jacxl.free.fr/
http://dj.joss.free.fr/
C:Program FilesMicrosoft OfficeOffice1036VBALIST.XLS


1 2 3