Copier des données et ajout de lignes dans une autres feuilles

Résolu/Fermé
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - Modifié par bassmart le 8/04/2015 à 17:55
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - 9 avril 2015 à 17:59
Bonjour à tous,

J'ai un fichier qui contient 1 feuille de compilation (générale) ensuite, j'ai 4 feuilles qui contiennent chacun des types de sondages réalisés pour une région.

J'ai une macro qui ce lance avec un bouton, qui tri mes numéros de sondage à partir de ma feuille générale (colonne C) et les copies ensuite dans chacune des feuilles selon leur type dans la colonne A ou colonne B(le type est déterminé avec la ou les premières lettres du sondage).

Voici la macro:
Sub CopieFeuillets()
' Macro de Copie & de Tri

Dim f As Worksheet

Application.ScreenUpdating = False

For Each f In ActiveWorkbook.Worksheets
    f.Unprotect
Next

   With Sheets("Coordonnées")
  
        For I = 1 To 4
            On Error Resume Next
            Erase critères
            On Error GoTo 0
            Select Case I
            
            Case 1
                wsn = "FORAGE"
                critères = Array("F", "FC", "FS", "FSZ")
                Col = "A" ' colonne dans laquelle mettre le n° de sondage, est également la colonne pour le tri
               PL = 8 'première ligne des données dans wsn
               tabtri = "A" & PL & ":n" ' tableau à trier
           Case 2
                wsn = "CPTU"
                critères = Array("C", "CR", "FC", "M")
                Col = "A"
                PL = 7
                tabtri = "A" & PL & ":o"
            Case 3
                wsn = "Piézomètres"
                critères = Array("Z", "FSZ")
                Col = "B"
                PL = 8
                tabtri = "A" & PL & ":m"
            Case 4
                wsn = "Inclinomètres"
                critères = Array("I")
                Col = "B"
                PL = 7
                tabtri = "A" & PL & ":H"
            End Select
           
            .Range("$A$4:$N$64").AutoFilter Field:=4, Criteria1:=critères, Operator:=xlFilterValues         'on filtre les données de coordonnées
           
           Set ws = Sheets(wsn)    ' ws = référence de la feuille
           nl = ws.Cells(Rows.Count, Col).End(xlUp).Row    ' nl pointeur de dernière ligne utilisée dans la feuille basé sur colonne col
           If nl < PL Then nl = PL - 1
            For Each r In .Range(.Range("C5"), .Range("C5").End(xlDown)).SpecialCells(xlVisible)    ' on parcourt toutes les cellules sélectionnées de la colonne  C, (r=cellule en cours)
               Set re = ws.Range(Col & ":" & Col).Find(r.Value, lookat:=xlWhole)    'on recherche le n°de sondage dans la colonne col
               If re Is Nothing Then    'si non trouvé
                   nl = nl + 1    ' on ajoute une nouvelle ligne
                   ws.Cells(nl, Col) = r.Value    ' on met le numéro de sondage en colonne col
               End If
            Next
            With ws.Range(tabtri & nl)
                .Sort key1:=.Cells(1, Col), order1:=xlAscending, Header:=xlNo
            End With
        Next I
        If Worksheets("Coordonnées").AutoFilterMode Then
            Worksheets("Coordonnées").AutoFilterMode = False
            
        End If
    End With
    

For Each f In ActiveWorkbook.Worksheets
    f.Protect
Next
    
Application.EnableEvents = True

End Sub




Dans chacune des 4 feuilles, j'ai une macro qui ajoute une ligne à la fin de mon tableau.

Voici un exemple de la macro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As Range, I&
Set T = [Tableau2]
Application.EnableEvents = False
On Error Resume Next 'sécurité
If T.Rows.Count < 4 Then
  Application.Undo 'annulation
Else
  '---suppression des lignes vides---
  For I = T.Rows.Count - 1 To 4 Step -1
    If T(I, 1) = "" Then T(I, 1).EntireRow.Delete
  Next
  '---ajout de ligne---
  If T(T.Rows.Count, 1) <> "" Then
    Application.ScreenUpdating = False
    T(T.Rows.Count, 1).EntireRow.Insert
    T.Rows(T.Rows.Count - 1).FormulaR1C1 = T.Rows(T.Rows.Count).FormulaR1C1
    T.Rows(T.Rows.Count) = ""
    Application.ScreenUpdating = True
  End If
End If

End Sub


Tout marche très bien si j'ajoute une seule donnée à la fois dans ma feuille générale et que je lance la macro après chaque données.

Le problème, c'est quand j'ajoute plusieurs données dans la feuille et que je lance la macro de tri, je me retrouve avec des données en bas de la dernière ligne vide. Je sais que le problème vient du fait qu'il garde seulement une ligne vide dans chacune des feuilles.

Comment puis-je corriger cette situation?

Est-ce que je suis mieux de faire exécuter une macro à chacune des nouvelles entrées dans ma feuille générale qui tri, copie et colle dans les autres feuilles?

Ou bien de modifier la macro qui ajoute des lignes automatiquement dans chacune de mes feuilles?

Ou encore de modifier la macro de tri pour qu'elle ajoute des lignes à chaque nouvelle données copiés dans une autres feuilles?

Voici le lien pour mon fichier:
https://www.cjoint.com/?0DipTOn2Z5r

En espérant que ce soit assez clair!

Merci pour votre aide!



A voir également:

1 réponse

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
9 avril 2015 à 16:43
Bonjour,

fichier modifie: https://www.cjoint.com/c/EDjq3O84VYX

modif a l'insertion de ligne macro: CopieFeuillets

A+
0
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1
9 avril 2015 à 17:59
Merci beaucoup pour ta réponse f894009!

Ça fonctionne parfaitement!
0