Aide sur Macro basique (copie avec filtre)

Question

Je sollicite votre aide pour la macro de copie SVP: j'ai déjà fait qq macro avec l'enregistreur et les moyen que je connais et je suis bloqué avec la macro de copie malgré que c'est fait mais avec erreur si les valeurs filtre change j'ai des valeurs en moins en copie. Macro Clear OK Macro Load Planning ou Staff OK Macro Copie Staff OK si possible de la modifier pour que soit plus PRO et copie que le staff dans la feuille Staff Global actuellement vue que c'est fait avec l'enregistreur donc je fait toujours 300 mm si le staff moins et les formule sont copié dans la feuille Shift Bidding I5 et J6 L8 donc une MAJ je dis pas non et merci mnt la macro copie que je me bloque je doit copier les ID de tous les agents SAUF les hors Offre dans la feuiille Rang Pass 2 Hebdo avec Profi d à partir de la cellule A3 et les Agents Hors Offre les copier dans la feuille Paramètres avec leurs ID et noms et la mention hors offre dans type (celllule L3) je compte sur votre aide précieuse et merci d'avance. PS je trouve pas comment ajouter la pièce jointe je viens de mettre le fichier sur Wetransfert. Merci...

Meryem Ben Lahbib · Accepted Answer

J'ai essayé de mettre le fichier ici mais cela n'a pas fonctionné car le fichier est trop lourd. En tout cas, j'ai apporté des modifications à la macro "Past". Veuillez tester le code ci-dessous :

Sub Past()
Dim DerniereLigne As Long
Dim FeuilleStaffGlobal As Worksheet
Dim FeuilleShiftBidding As Worksheet

Set FeuilleStaffGlobal = ThisWorkbook.Sheets("Staff Global")
Set FeuilleShiftBidding = ThisWorkbook.Sheets("Shift Bidding")

DerniereLigne = FeuilleStaffGlobal.Cells(FeuilleStaffGlobal.Rows.Count, "A").End(xlUp).Row

FeuilleStaffGlobal.Range("A2:A" & DerniereLigne).Copy
FeuilleShiftBidding.Range("I7").PasteSpecial Paste:=xlPasteValues

FeuilleStaffGlobal.Range("B2:B" & DerniereLigne).Copy
FeuilleShiftBidding.Range("J7").PasteSpecial Paste:=xlPasteValues

FeuilleStaffGlobal.Range("C2:C" & DerniereLigne).Copy
FeuilleShiftBidding.Range("L7").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

End Sub

Meryem Ben Lahbib · Answer

Pouvez-vous fournir un tableau à titre d'exemple pour mieux comprendre la structure du tableau ...

Meryem Ben Lahbib · Answer

J'ai créé une macro pour copier les ID de tous les agents sauf les "Hors Offre" dans la feuille "Rang Pass 2 Hebdo avec Profi" à partir de la cellule A3. Merci de tester la macro.

Sub Tous_Sauf_Hors_Ligne()

Dim DernièreLigne As Long
Dim Feuille As Worksheet

Set Feuille = ThisWorkbook.Sheets("Staff Global")

DernièreLigne = Feuille.Cells(Feuille.Rows.Count, "A").End(xlUp).Row

Feuille.Range("A1:C1").AutoFilter
Feuille.Range("A1:C" & DernièreLigne).AutoFilter Field:=3, Criteria1:="<>Hors Offre"

Feuille.Range("A2:A" & DernièreLigne).SpecialCells(xlCellTypeVisible).Copy
Sheets("Rang Pass 2 Hebdo avec Profi d").Range("A3").PasteSpecial Paste:=xlPasteValues

Feuille.AutoFilterMode = False
Application.CutCopyMode = False

End Sub

Meryem Ben Lahbib · Answer

J'ai créé une deuxième macro pour copier les agents "Hors Offre" dans la feuille "Paramètres" avec leurs ID et noms, en ajoutant la mention "Hors Offre" dans la colonne L à partir de la cellule L3. Voici la macro ci-dessous :

Sub Hors_Offre()

Dim DL As Long
Dim Feuille As Worksheet

Set Feuille = ThisWorkbook.Sheets("Staff Global")

DL = Feuille.Cells(Feuille.Rows.Count, "A").End(xlUp).Row

Feuille.Range("A1:C1").AutoFilter
Feuille.Range("A1:C" & DL).AutoFilter Field:=3, Criteria1:="Hors Offre"

Feuille.Range("A2:C" & DL).SpecialCells(xlCellTypeVisible).Copy
Sheets("Paramètres").Range("J3").PasteSpecial Paste:=xlPasteValues

Feuille.AutoFilterMode = False
Application.CutCopyMode = False
Range("M5").Select
End Sub

Meryem Ben Lahbib · Answer

J'espère que ces codes fonctionnent correctement...

Meryem Ben Lahbib · Answer

Bonjour,

Voici la macro avec les modifications apportées. Cette macro permet de filtrer les données de les copier dans un nouveau classeur et de l'enregistrer sur le bureau.

Sub Hors_Offre()

Dim Feuille As Worksheet
Dim DL As Long

Set Feuille = ThisWorkbook.Sheets("Staff Global")
DL = Feuille.Cells(Feuille.Rows.Count, "A").End(xlUp).Row

Feuille.Range("A1:C1").AutoFilter
Feuille.Range("A1:C" & DL).AutoFilter Field:=3, Criteria1:="Hors Offre"
Feuille.Range("A2:C" & DL).SpecialCells(xlCellTypeVisible).Copy

Workbooks.Add.Sheets(1).Range("A2").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

Dim Bureau As String
Bureau = CreateObject("WScript.Shell").SpecialFolders("Desktop")

ActiveWorkbook.SaveAs Filename:=Bureau & "\Seulement Hors Offre " & ".xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close False

MsgBox ("Terminé")

End Sub

Meryem Ben Lahbib · Answer

Lah ikber bik...