Decoupage fichier Excel
Bonjour à tous,
J,ai besoin de vous pour un fichier excel. J,arrive à le decouper mais je voudrais qu'il me colle les lignes correspondante sur les nouvelle feuilles.
Je vous joint le fichier
Bonjour
quelles lignes , selon quels critères ?
Peux tu compléter une ou deux feuilles "résultats attendus"
Merci
Cordialement
FINDRH
Désoler, Je choisit la feuille 1 --> Tri sur la colonne 4 (Homme,Femme)
Cela me cree 2 nouvelle feuilles avec comme nom Homme et Femme. Je voudrais qu'il me copie la ligne correspondant au critere.
Sur la feuille Homme --> toutes les lignes homme
Sur la feuille Femme --> toutes les lignes Femme
J'ai réussi pour les entetes mais je bloc sur le reste.
Resultat que je voudrais.
Merci de ton aide
Bonjour
ci joint une proposition
aller sur la feuille source ( feuille 1)
lancer la macro Ctrl Maj T
A priori ça marche
Cordialement
FINDRH
Le tableau que j'avais joint est un exemple. Mon tableau réel à 220000 lignes et 23 colonnes. Je ne peu pas faire comme vous m'avais dit car je peu avoir entre 1 et 220000 critéres.
Sur le premier tableau que je vous ai envoyé, je peu crée des nouvelles feuille avec n'importe qu'elle colonne que j'ai renseigné.
Je pense qu'il faudrait le faire à ce niveau :
Private Function splitOnSheet(tabVal() As String)
Dim i As Integer
For i = LBound(tabVal) To UBound(tabVal) - (1 + 1)
Application.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = tabVal(i)
Sheets("Feuil1").Select
Rows("2:2").Select
Selection.Copy
Sheets(tabVal(i)).Select
Rows("2:2").Select
ActiveSheet.Paste
Range("C8").Select
ICI
Next i
Debug.Print (i)
End Function
tabval(i) = la variable pour le decoupage
Le resultat est bon mais est ce que je peu choisir n'importe quel colonne ?
Re,
A qui s'adresse la question?
Oui c'est vrai.
A toi, en faite, il faudrait que la valeur de Fieldnum soit égal à la colonne que je renseigne
C'est bon, j'ai trouvé grace à vous.
Merci et bonne soirée
Re,
Pense à clore le sujet.
Bonne soirée.
Petit probleme:
Un collegue à toucher à ma macro et elle ne fonctionne plus
Le message d'erreur me dit variable non définit
Voici la macro :
Option Explicit
Option Base 0
Public Sub Test()
Dim ws As Worksheet
Dim WSNew As Worksheet
Dim rng As Range, cell As Range
Dim Lrow As Long, FieldNum As Long
Dim objList As ListObject
Dim CCount As Long
Dim p As Integer
p = Input_Choix( _
Titre:="Choix colonne de découpage", _
texte:="Entrer le numéro de la colonne à découper")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
Next ws
On Error GoTo 0
Application.DisplayAlerts = True
Set rng = [A1]
Set objList = rng.ListObject
FieldNum = p
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Set ws = Worksheets.Add(after:=Sheets(Sheets.Count))
With ws.Range("A1")
objList.ListColumns(FieldNum).Range.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), _
Unique:=True
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)
objList.Range.AutoFilter Field:=FieldNum, Criteria1:=cell.Value
CCount = 0
On Error Resume Next
CCount = objList.ListColumns(1).Range.SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
On Error GoTo 0
If CCount <> 0 Then
Set WSNew = Worksheets.Add(after:=Sheets(Sheets.Count))
WSNew.Name = cell.Value
objList.Range.SpecialCells(xlCellTypeVisible).Copy
With WSNew.Range("A1")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
End If
objList.Range.AutoFilter Field:=FieldNum
Next cell
On Error Resume Next
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
On Error GoTo 0
End With
Application.ScreenUpdating = True
MsgBox ("Découpage réussi")
End Sub
Private Function Input_Choix(Titre As String, texte As String)
Input_Choix = Application.InputBox( _
texte, _
Titre, _
Type:=1)
End Function
Bonjour,
Et avec :
objList.ListColumns(p).Range.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), _
Unique:=TrueC'est pareil en remplacant FieldNum par p
Re,
Remplace tous les FieldNum par p et explique moi :
p = Input_Choix( _
Titre:="Choix colonne de découpage", _
texte:="Entrer le numéro de la colonne à découper")Sinon, envoie ton fichier.
Cdlt.
Désoler de t'avoir déranger.
En faite, j'ai oublié qu'il faut transformer en tableau avant de lancer la Macro.
Encore désoler et merci
Re,
Pas de quoi.
A bientôt sur le forum.
Cdlt.
Bonjour Jean Eric,
Voici mon petit probleme :
J'ai un fichier excel avec 2 pages qui contiennent 1 TCD chacunes.
Quand j'enregistre mon fichier en page web, mes filtres disparaissent. Comment faire pour garder les filtres ?
Bonjour,
Je ne sais pas.
Désolé.
Cdlt.