Discussion :

[pheonix00fr]

Bonjour,
J’aurais besoin d’aide pour mettre au point un projet que je crée.
J’ai un classeur avec quatre feuilles (Liste, tab1, tab2 et tab3), dans Liste j’ai un tableau de B5 à F500. Je l’alimente au fur et à mesure et je voudrais copier-coller les nouvelles lignes dans les tableaux des autres feuilles en fonction de la valeur des cellules D, E et F du tableau de Liste. Pour envoyer la ligne vers la feuille,
Tab1, il faut « X » dans la cellule D,
Tab2, il faut « X » dans la cellule E,
Tab3, il faut « X » dans la cellule F,
Les trois, deux ou une de ces cellules peuvent avoir la valeur X.

Merci de votre aide.

[Nako_lito]

faut que tu te fasse une boucle sur toute les lignes des ton tableau principal et que tu regarde la cellule ("D" & i), ("E" & i), ("F" & i). Si c'est différent que chaine vide, tu copie la cellule ("A" & i) et tu colle dans le classeur correspondant.
La feuille excel porte le nom = numéro de colonne - 3.

Un exemple rapide :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Sub toto()
    Dim x, i, j, r As Integer
 
    x = ThisWorkbook.Sheets("Liste").UsedRange.Rows.Count
    For i = 1 To x 'parcourir toute les lignes de la feuille LISTE
        For j = 4 To 6 'parcourir les colonnes D, E, F
            If LCase(ThisWorkbook.Sheets("Liste").Cells(i, j).Value) = "x" Then 'si y'a une correspondance dans la cellule i,j 
                r = ThisWorkbook.Sheets("Tab" & j - 3).Range("A25000").End(xlUp).Row + 1 'récupère la dernière ligne + 1 du Tab concerné
                ThisWorkbook.Sheets("Tab" & j - 3).Range("A" & r).Value = ThisWorkbook.Sheets("Liste").Range("A" & i).Value 'copie la valeur qui est dans LISTE vers TAB
            End If
        Next
    Next
End Sub

[eric4459]

Bonjour Phoenix,
Où places-tu les lignes copiées dans les onglets tab1, 2 et 3? J'ai considéré l'hypothèse que les données sont collées en colonne B.
Je suis en train d'écrire un code et j'ai supposé qu'il y avait déjà des lignes sur ces feuilles, mon code permettra de coller les nouvelles lignes à la suite.
Eric

[pheonix00fr]

Merci pour ton aide, voici le fichier de base pour mieux "voir".

[eric4459]

Bonsoir Phoenix,
J'ai vu ton fichier trop tard pour pouvoir modifier le mien, mais en gros si tu suis en pas à pas tu devrais pouvoir saisir ce que j'ai voulu faire et tu pourras l'adapter si cela te convient. (Grand week-end pour moi dés ce soir )
J'ai mis un compteur en H1 de l'onglet LISTE, ici mis à 25 pour mes tests, lors de l'ajout de nouvelles lignes sur cet onglet se sera ma référence.
En espérant que ce que j'ai fait soit assez clair.
Eric
Code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Option Explicit
 Sub Mise_à_Jour()
 
 
    Dim wks1 As Worksheet
    Dim wks2 As Worksheet
    Dim wks3 As Worksheet
    Dim wks4 As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim EndOfCell As Long
    Dim nblig1 As Long
    Dim nblig2 As Long
    Dim nblig3 As Long
    Dim nblig4 As Long
    Dim nblig5 As Long
    Dim Plage As String
    Set wks1 = ThisWorkbook.Worksheets("Liste")
    Set wks2 = ThisWorkbook.Worksheets("tab1")
    Set wks3 = ThisWorkbook.Worksheets("tab2")
    Set wks4 = ThisWorkbook.Worksheets("tab3")
 
    With wks1
        nblig1 = Range("B1").End(xlDown).Row
    End With
 
    With wks2
        nblig3 = wks2.Range("B1").End(xlDown).Row
    End With
 
    With wks3
        nblig4 = wks3.Range("B1").End(xlDown).Row
    End With
 
    With wks4
        nblig5 = wks4.Range("B1").End(xlDown).Row
    End With
 
     Application.ScreenUpdating = False
 
    If nblig1 > Range("H1").Value Then
    Range("B" & Range("H1").Value + 1).Activate
    Cells(ActiveCell.Row, 2).EntireRow.Insert
    Range("B" & Range("H1").Value + 2).Activate
    nblig2 = Range("B" & Range("H1").Value + 3).End(xlDown).Row
    MsgBox ((nblig2 - (Range("H1") + 1)) & " nouvelle(s)ligne(s) ajoutée(s)")
    Range("B" & Range("H1") + 2).Select
    End If
    'i = (Range("H1") + 2)
    j = 0
    EndOfCell = nblig2
 
    For i = (Range("H1") + 2) To EndOfCell
        If Range("D" & i) = "X" Then
        Range("B" & i).Select
        Range(Selection, Selection.End(xlToRight)).Copy
        wks2.Range("B" & (nblig3 + j)).PasteSpecial
        End If
        If Range("D" & i + 1) = "X" Then
        j = j + 1
        Else
        j = j
        End If
    Next i
 
    j = 0
    For i = (Range("H1") + 2) To EndOfCell
        If Range("E" & i) = "X" Then
        Range("B" & i).Select
        Range(Selection, Selection.End(xlToRight)).Copy
        wks3.Range("B" & (nblig4 + j)).PasteSpecial
        End If
        If Range("E" & i + 1) = "X" Then
        j = j + 1
        Else
        j = j
        End If
    Next i
 
    j = 0
    For i = (Range("H1") + 2) To EndOfCell
        If Range("F" & i) = "X" Then
        Range("B" & i).Select
        Range(Selection, Selection.End(xlToRight)).Copy
        wks4.Range("B" & (nblig5 + j)).PasteSpecial
        End If
        If Range("F" & i + 1) = "X" Then
        j = j + 1
        Else
        j = j
        End If
    Next i
 
    Range("B" & Range("H1").Value + 1).Activate
    Cells(ActiveCell.Row, 2).EntireRow.Delete
 
    Range("H1") = nblig1
    Range("H2") = nblig2 - 1
    Application.CutCopyMode = False
    MsgBox ("Terminé")
     Application.ScreenUpdating = True
   End Sub

Fichier Joint: Copier nouvelles lignes.xlsm

[pheonix00fr]

Je nage complet, je n'arrive pas à la faire fonctionner.
Si j'ai bien compris la macro compte les lignes du tableau et calcule si il y a une différence avec le dernier comptage, mais j'ai souvent des erreurs sur le nombre de lignes ajoutés, parfois pour une ajouté elles m’en trouvent plus de 1048545 (un peu beaucoup). Le problème de cette méthode c'est que si la valeur "X" est ajouté dans une les cellules D E ou F d'une ligne déjà existante le transfert ver les autres ne se fera pas.
Quand j’ajoute des valeurs dans le tableau, que le compteur ne s’affole pas et que la cellule contient bien la valeur X le transfert ne se fait pas.



Le fichier avec la macro