XL 2013 archiver plusieurs ligne en même temps

[Ray97]

Dans ma base de données sur excel ,j'ai une liste avec plusieurs famille qui sont identifiés par leur numero de foyer . Je veux archiver une famille par exemple si j'ai 5 membre d'une seule famille dans la liste ,je veux qu'il soit supprimer dans la première feuille et coller dans une pages d'archives.
J'ai commencé à le faire en m'aidant d'une macro filtre mais je crois que c'est long et je suis bloquée.

Pouvez vous me proposer d' autre idée plus simple ou m'aider sur celui que j'ai commencé.
Merci d'avance
voici le code:
Private Sub continuer_Click()
Dim taille As Integer
taille = WorksheetFunction.CountA(Columns("A:A")) 'Si A est une colonne qui contient des donn?es non vides
If MsgBox("?tes-vous certain(e) de vouloir archiver le foyer de " & list_nom.Value _
& " dans la " & ActiveSheet.Name & " ?", vbYesNoCancel _
, "Demande de confirmation") = vbYes Then
Call filtre1(list_foyer.Value)
' tu s?lectionnes la plage (ici, les colonnes A ? D, limit?es au nombre de ligne remplies)
Range("A4:AJ" & taille).SpcialCells(x1lTypeVisible).Select

'on les copie
Selection.Cut
Sheets("Archives").Select
'Tu s?l?ctionnes le classeur F1 puis la feuille 2 puis la cellule A1
l = ActiveSheet.["A65536"].End(x1Up).Row + 1

I = Sheets("Archives").Range("A65536").End(xlUp).Row

Range("A" & I).Select
ActiveSheet.Paste
ActiveSheet.Cells(l, 1) = Tdate
Else
Unload Me
End If
Call effacer_filtre
Unload Me
End Sub

la procédure filtre1:
Sub filtre1(list_foyer As String)

Rows("3:3").Select
Selection.AutoFilter
ActiveSheet.Range("$A$3:$GM$15").AutoFilter Field:=2, Criteria1:=list_foyer



Merci

 

[Ray97]

Et aussi ça serait possible de faire que à chaque fois qu'on archive un foyer qu'il est la date ( colonne A).

Merci

 

[Robert]

Re,

En pièce jointe la version 2. Clique sur le bouton Archiver de l'onglet Feuil1. Dans la boîte de dialogue, tape le texte à chercher. La recherche se fait uniquement sur les 6 premières colonnes du tableau. Si une cellule de la ligne contient le texte tapé, la ligne entière s'affiche (du moins, les 6 premières colonnes). Clique sur une ligne dans la ListBox1. Message puis archivage...

 

[Ray97]

le code fonctionne merci mais j'ai un petit souci quand j'archive la ligne archiver ne se supprime pas.

 

[Ray97]

Quand j'archive ,il commence à la ligne 6, il me prend pas le bon. Je t'envois le fichier pour que tu puisses tester.
Merci

 

[Robert]

Re,

J'ai vu ou étais le problème (comme je te l'ai dit depuis le début, pas la même structure) mais la je n'ai plus le temps... Peut-être ce soir...

 

[Ray97]

D'accord merci

 

[Robert]

Re,

En pièce jointe ton fichier modifié et testé. Clique sur le bouton Menu...

 

[Ray97]

Merci beaucoup Robert d'avoir consacrer ton temps à m'aider. Le code fonctionne bien.

 

[Ray97]

J'aurai une autre question sur un autre thème mais c'est sur le même tableau. Je crée un autre titre ou je peux continuer ici.?

 

[Ray97]

Bonjour Robert,

Excusez moi, je voulais savoir si tu pourrais m'aider sur l'autre thème s'il vous plait.

merci

 

[Robert]

Bonjour Ray, bonjour le forum

Ce forum d'entraide est général. S'adresser à moi directement risque de te priver de l'aide d'autres éminents membres. En tous cas, pour ma part, c'est ce que je fais. Si un demandeur s'adresse à quelqu'un en particulier je ne réponds pas...
Si tu m'envoies le lien vers ton autre problème j'essaierai d'y jeter un œil si j'ai le temps et les compétences nécessaires pour t'aider.

 

[Ray97]

AH d'accord je ne savais pas.
Merci de m'avoir prévenu.

 

[Ray97]

Voici le lien merci.
Private Sub Menu_Click()
Dim TL(1) As Long

'Application.ScreenUpdating = False
derlig = Range("A" & Rows.Count).End(xlUp).Row
n = 4
Do While n <= derlig
L = Range("U" & n)
If L <> "" Then
LD = n + 1
LF = n + L - 1
'ajout x ligne(s)
Rows(LD & ":" & LF).Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
'recopie infos BCD, LMN, increment K de 1 a x
Range("B" & n & "😀" & n).Copy Range("B" & LD & "😀" & LF)
Range("L" & n & ":M" & n).Copy Range("L" & LD & ":M" & LF)
Application.CutCopyMode = False
NPF = 1
LD = LD - 1
LF = LF
For m = LD To LF
Range("AG" & m) = NPF
NPF = NPF + 1
Next m
n = n + L
derlig = Range("A" & Rows.Count).End(xlUp).Row
Else
n = n + 1
End If
Loop
'Application.Calculation = xlCalculationManual
' je veux incrementer
'.Range("AD" & AJ) = .Range("AD" & AJ - 1).Formula + .Range("AD" & AJ - 1)
'Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[Ray97]

Bonjour tous le monde,

Voici le lien pour que vous puissiez m'aider.

XL 2013 - Insertion de plusieurs lignes en fonction d'une valeur avec une incrémentation

Bonjour, Je reviens vers vous pour une demande d'aide. Je veux insérer des lignes en fonction d'un nombre de cellules qui à sur une colonne ici la colonne U. je veux que dans la colonne AG je puisse faire une incrémentation du nombre de ligne insérer. et je veux que les lignes copient les mêmes...

www.excel-downloads.com

Merci d'avance

 

[Kamy]

Re,

En pièce jointe ton fichier modifié et testé. Clique sur le bouton Menu...

Bonjour,

En faisant mes recherches je suis tombé sur votre post, le vba formulaire dans le fichier joint est parfait pour mon besoin ! je me permet de le récupérer pour l'adapter à mon besoin !

Merci pour le partage !

Mais ayant un grand manque de connaissance, je bloque.

Les lignes que je veux copier/coller ont des cellules avec des formules index et equiv ou recherchev, je souhaiterais que le collage de la ligne soit réalisé en collage spécial/valeur, je ne comprend pas comment modifier cette partie.

Auriez-vous svp la possibilité de m'aider à modifier le code ?

En vous remerciant d'avance.