XL 2013 Sélection et copie d'une zone de liste filtrée par Excel

fmaurice54

fmaurice54

XLDnaute Nouveau
Bonjour

Je cherche à automatiser des taches répétitives dans un fichier.
Pour cela il faut :
1. que je recopie des feuilles de manière automatique, avec des valeurs autocalculées. :p Ca j'ai réussi à faire tout seul:eek::eek::eek:
2. il faut que j'ajoute des éléments dans une table, en fonction d'éléments filtrer par macro ! :mad::mad: Ca j'arrive pas.
Je dois pour chaque contrat dans la feuille Index, créer une ligne reprennant des données de SOURCE_MANDARIN_CONTRAT et de TABLEAU_CONTRAT dans la feuille SOURCE_REGION_CONTRAT

Voici le code utilisé :
Code: 
Sub macro1()
Dim i As Integer
Dim nom As String
Dim j As Integer
Dim MaPlage As Range
Dim MaPlageCourte As Range


Set MaPlage = Sheets("SOURCE_MANDARIN_CONTRAT").Range("A:AX")
Set MaPlage = MaPlage.SpecialCells(xlCellTypeVisible)
Set MaPlageCourte = Sheets("SOURCE_MANDARIN_CONTRAT").Range("A:E")
Set MaPlageCourte = MaPlage.SpecialCells(xlCellTypeVisible)

j = Sheets("Index").Cells(1, 3)

For i = 2 To 5
nom = Sheets("Index").Cells(i, 1)
nomcourt = Sheets("Index").Cells(i, 2)

    MaPlage.AutoFilter Field:=3, Criteria1:=nom
    Set MaPlage = MaPlage.SpecialCells(xlCellTypeVisible)
    Set MaPlageCourte = MaPlage.SpecialCells(xlCellTypeVisible)
    
    Sheets("TABLEAU_CONTRAT").Select                            ' ca c'est pour dupliquer mes feuilles, ca marche
    Application.CutCopyMode = False
    Sheets("TABLEAU_CONTRAT").Copy Before:=Sheets(1)            ' ca c'est pour dupliquer mes feuilles, ca marche
          Sheets("TABLEAU_CONTRAT (2)").Range("A1:g33").Select  ' ca c'est pour dupliquer mes feuilles, ca marche
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("TABLEAU_CONTRAT (2)").Name = nomcourt   ' ca c'est pour dupliquer mes feuilles, ca marche

Sheets("SOURCE_REGION_CONTRAT").Cells(i, 1) = MaPlageCourte ' ca c'est ce qui ne marche pas !!

Next i

End Sub
Je joint le fichier :

Merci pour votre aide
 

Pièces jointes

  • Tableau_Invest_DPI_2_Contrat_V3.1 modifié.xlsm
    113 KB · Affichages: 26
  • Tableau_Invest_DPI_2_Contrat_V3.1 modifié.xlsm
    113 KB · Affichages: 31
Trier par date Trier par votes
Paritec

Paritec

XLDnaute Barbatruc
Re : Sélection et copie d'une zone de liste filtrée par Excel

Bonjour fmaurice54 le forum
moi je ne comprend pas ce que tu veux, merci d'ajouter un onglet avec le résultat souhaité fait a la main avec la provenance des cellules importées (ligne colonne) par rapport à quoi aussi, et je vais te faire cela sans souci
a+
Papou:)
 
Vote positif 0 Vote négatif
fmaurice54

fmaurice54

XLDnaute Nouveau
Re : Sélection et copie d'une zone de liste filtrée par Excel

Bonjour Paritec,

Merci d'avoir pris connaissance de mon poste et pris de temps de répondre.
Après avoir cherché pas mal, j'ai enfin trouvé la réponse à ma question :

Code: 
Sub macro1()
Application.ScreenUpdating = False
Dim i As Integer
Dim nom As String

Dim j As Integer
Dim MaPlage As Range


Dim DrLig As Long


Set MaPlage = Sheets("SOURCE_MANDARIN_CONTRAT").Range("A:AX")
Sheets("Index").Range("A1").Select
nbLignes = Range("A1", Selection.End(xlDown)).Cells.Count


i = 0
j = nbLignes


    With Sheets("SOURCE_MANDARIN_CONTRAT")
        If .AutoFilterMode Then
            .Cells.AutoFilter
        End If
    End With

For i = 2 To j

nom = Sheets("Index").Cells(i, 1)
nomcourt = Sheets("Index").Cells(i, 3)


    MaPlage.AutoFilter Field:=2, Criteria1:=nom
    Set MaPlage = MaPlage.SpecialCells(xlCellTypeVisible)
    DrLig = Sheets("SOURCE_MANDARIN_CONTRAT").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row 'c'est ça que je cherchait à faire
       Sheets("SOURCE_MANDARIN_CONTRAT").Select 'c'est ça que je cherchait à faire
    Range("A" & DrLig & ":C" & DrLig).Select 'c'est ça que je cherchait à faire
    Selection.Copy
    Sheets("SOURCE_REGION_CONTRAT").Select
    Range("A" & i).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    



Next i

Application.ScreenUpdating = True
End Sub

Je cherchait à copier uniquement la ligne sélectionnée après application d'un filtre dans une sélection.

Cordialement,

F.
 
Vote positif 0 Vote négatif
fmaurice54

fmaurice54

XLDnaute Nouveau
Re : Sélection et copie d'une zone de liste filtrée par Excel

Voici l'intégralité de mon code :

Code: 
Sub macro1()
Application.ScreenUpdating = False
Dim i As Integer
Dim nom As String

Dim j As Integer
Dim MaPlage As Range
Dim MaPlageCourte As Range

Dim DrLig As Long

Dim nbLignes As Integer

    With Sheets("SOURCE_MANDARIN_CONTRAT")
        If .AutoFilterMode Then
            .Cells.AutoFilter
        End If
    End With
    
Sheets("SOURCE_MANDARIN_CONTRAT").Select

    Columns("B:C").Select
    Selection.Copy
    Sheets("Index").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:B").Select
    Application.CutCopyMode = False
    ActiveSheet.Range("$A:B").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes


Set MaPlage = Sheets("SOURCE_MANDARIN_CONTRAT").Range("A:AX")
Sheets("Index").Range("A1").Select
nbLignes = Range("A1", Selection.End(xlDown)).Cells.Count

    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=SUBSTITUTE(LEFT(RC[-1],20)&IF(LEFT(RIGHT(RC[-2],4))=""_"",RIGHT(RC[-2],4),),""'"","""")"
    Selection.AutoFill Destination:=Range("C2:C" & nbLignes)

i = 0
j = nbLignes


    With Sheets("SOURCE_MANDARIN_CONTRAT")
        If .AutoFilterMode Then
            .Cells.AutoFilter
        End If
    End With

For i = 2 To j

nom = Sheets("Index").Cells(i, 1)
nomcourt = Sheets("Index").Cells(i, 3)


    MaPlage.AutoFilter Field:=2, Criteria1:=nom
    Set MaPlage = MaPlage.SpecialCells(xlCellTypeVisible)
    DrLig = Sheets("SOURCE_MANDARIN_CONTRAT").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
    
    Sheets("TABLEAU_CONTRAT").Select                            ' ca c'est pour dupliquer mes feuilles, ca marche
    Application.CutCopyMode = False
    Sheets("TABLEAU_CONTRAT").Copy Before:=Sheets(1)            ' ca c'est pour dupliquer mes feuilles, ca marche
    Sheets("TABLEAU_CONTRAT (2)").Range("A1:g33").Select  ' ca c'est pour dupliquer mes feuilles, ca marche
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


    Sheets("TABLEAU_CONTRAT (2)").Name = nomcourt   ' ca c'est pour nommer les feuilles
    Sheets(nomcourt).Cells(1, 1) = "CONTRAT : " & nomcourt  ' ca c'est pour nommer les feuilles
    Sheets(nomcourt).Cells(35, 1) = "CONTRAT : " & nom ' ca c'est pour nommer les feuilles
 

    Sheets("SOURCE_MANDARIN_CONTRAT").Select
    Range("A" & DrLig & ":C" & DrLig).Select
    Selection.Copy
    Sheets("SOURCE_REGION_CONTRAT").Select
    Range("A" & i).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Cells(i, 4).FormulaR1C1 = _
    "=IF(LEFT(RIGHT(R[0]C[-2],4))=""_"",""Multi Communes"",LEFT(R[0]C[-1],FIND(""-"",R[0]C[-1])-1))"
    
    Cells(i, 5).FormulaR1C1 = _
        "=IF(LEFT(RIGHT(R[0]C[-3],4))=""_"",""Multi Communes"",RIGHT(R[0]C[-2],LEN(R[0]C[-2])-FIND(""-"",R[0]C[-2])))"
    
    Cells(i, 6).Formula = "='" & nomcourt & "'!$H$4"
    Cells(i, 7).Formula = "='" & nomcourt & "'!$i$4"
    Cells(i, 8).Formula = "='" & nomcourt & "'!$j$4"
    
    
    Cells(i, 9).Formula = "='" & nomcourt & "'!$H$5"
    Cells(i, 10).Formula = "='" & nomcourt & "'!$i$5"
    Cells(i, 11).Formula = "='" & nomcourt & "'!$j$5"

    Cells(i, 12).Formula = "='" & nomcourt & "'!$H$6"
    Cells(i, 13).Formula = "='" & nomcourt & "'!$i$6"
    Cells(i, 14).Formula = "='" & nomcourt & "'!$j$6"

    Cells(i, 15).Formula = "='" & nomcourt & "'!$H$8"
    Cells(i, 16).Formula = "='" & nomcourt & "'!$i$8"
    Cells(i, 17).Formula = "='" & nomcourt & "'!$j$8"

    Cells(i, 18).Formula = "='" & nomcourt & "'!$H$9"
    Cells(i, 19).Formula = "='" & nomcourt & "'!$i$9"
    Cells(i, 20).Formula = "='" & nomcourt & "'!$j$9"

    Cells(i, 21).Formula = "='" & nomcourt & "'!$H$11"
    Cells(i, 22).Formula = "='" & nomcourt & "'!$i$11"
    Cells(i, 23).Formula = "='" & nomcourt & "'!$j$11"

    Cells(i, 24).Formula = "='" & nomcourt & "'!$H$12"
    Cells(i, 25).Formula = "='" & nomcourt & "'!$i$12"
    Cells(i, 26).Formula = "='" & nomcourt & "'!$j$12"


    Cells(i, 27).Formula = "='" & nomcourt & "'!$H$13"
    Cells(i, 28).Formula = "='" & nomcourt & "'!$i$13"
    Cells(i, 29).Formula = "='" & nomcourt & "'!$j$13"

    Cells(i, 30).Formula = "='" & nomcourt & "'!$H$14"
    Cells(i, 31).Formula = "='" & nomcourt & "'!$i$14"
    Cells(i, 32).Formula = "='" & nomcourt & "'!$j$14"
    
     Cells(i, 33).Formula = "='" & nomcourt & "'!$H$17"
    Cells(i, 34).Formula = "='" & nomcourt & "'!$i$17"
    Cells(i, 35).Formula = "='" & nomcourt & "'!$j$17"
    
    
    
      Cells(i, 36).Formula = "='" & nomcourt & "'!$H$18"
    Cells(i, 37).Formula = "='" & nomcourt & "'!$i$18"
    Cells(i, 38).Formula = "='" & nomcourt & "'!$j$18"
    
    
      Cells(i, 39).Formula = "='" & nomcourt & "'!$H$20"
    Cells(i, 40).Formula = "='" & nomcourt & "'!$i$20"
    Cells(i, 41).Formula = "='" & nomcourt & "'!$j$20"
    
    
       Cells(i, 42).Formula = "='" & nomcourt & "'!$H$21"
    Cells(i, 43).Formula = "='" & nomcourt & "'!$i$21"
    Cells(i, 44).Formula = "='" & nomcourt & "'!$j$21"
    
    
      Cells(i, 45).Formula = "='" & nomcourt & "'!$H$22"
    Cells(i, 46).Formula = "='" & nomcourt & "'!$i$22"
    Cells(i, 47).Formula = "='" & nomcourt & "'!$j$22"
    
    
      Cells(i, 48).Formula = "='" & nomcourt & "'!$H$25"
    Cells(i, 49).Formula = "='" & nomcourt & "'!$i$25"
    Cells(i, 50).Formula = "='" & nomcourt & "'!$j$25"
    
    
     Cells(i, 51).Formula = "='" & nomcourt & "'!$H$26"
    Cells(i, 52).Formula = "='" & nomcourt & "'!$i$26"
    Cells(i, 53).Formula = "='" & nomcourt & "'!$j$26"
    
    
Next i
MsgBox ("Voilà, vous n'avez plus qu'à remplir " & nbLignes - 1 & " onglets")

Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
Paritec

Paritec

XLDnaute Barbatruc
Re : Sélection et copie d'une zone de liste filtrée par Excel

Bonsoir fmaurice54 le forum
si ton code te convient c'est parfait pour moi aussi, on peut considérablement l'améliorer, c'est pour cela que je demandais des renseignements, mais comme tu préfères ne pas répondre !!
bonne soirée
a+
Papou:)
 
Vote positif 0 Vote négatif
fmaurice54

fmaurice54

XLDnaute Nouveau
Re : Sélection et copie d'une zone de liste filtrée par Excel

Bonjour Paritec,
Merci pour ta proposition.
Je suis sûr que mon code peut être considérablement amélioré.
Et je serai intéressé pour apprendre à faire plus simple et plus juste.
Cependant, je suis très chargé en ce moment et puis cette macro est une macro que je n'utilise qu'une seule fois.
Cette macro me permet de gagner du temps de préparation sur mon fichier Excel.
Maintenant que mon fichier est préparé (mis en forme) il faut que je travaille le fond... et ça c'est pas une macro qui pourrat me le faire.

Encore merci de ton aide,

A une prochaine surement

Francois
 
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
217
Compte Supprimé 979
C
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
111
marie3107
M
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
236
florian50470
F
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
159
marie3107
M
M
  • Question
XL 2010 Calcul possible dans la zone de liste pour le débit et le crédit lors d'une recherche basée sur la zone de texte
Réponses
0
Affichages
429
Mody200
M
P
  • Question
Microsoft 365 Problème de destination à l'exécution d'une macro
Réponses
2
Affichages
286
Pimpon974
P
Z
  • Question
XL 2021 VBA Prélèvement d'une donnée si une valeur recherchée est identique
Réponses
3
Affichages
196
ZiM
Z
D
  • Résolu(e)
erreur VBA
Réponses
4
Affichages
698
Dangdang
D
C
  • Résolu(e)
XL 2019 Copier et renommer (en même temps) des feuilles à partir d'une liste de noms dans un colonne
Réponses
13
Affichages
622
Clemee61
C
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
232
guiyom
G

Membres actuellement en ligne

3 membres et 54 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 294
Messages
2 086 899
Membres
103 404
dernier inscrit
sultan87