Discussion :

[Pierre67]

Bonjour,

dans une feuille, en colonne A j'ai une série de (par exemple 5 noms)
dans une seconde feuille, j'ai une liste complète de noms (total 10 par ex)

en Vba, je souhaite compléter la liste en feuille en rajoutant les noms manquants récupérés dans la feuille B.

en colonne A feuille1
nom1
nom2
nom4

en colonne A feuille2
nom1
nom2
nom3
nom4
nom5

en feuille 1
jz souhaite compléter ma liste
pour obtenir
nom1
nom2
nom4
nom3
nom5

je suppose que pour beaucoup d'entre vous c'est un jeu d'enfant mais pas pour moi

si quelq'un peut m'aider

cordialement

merci

[mercatog]

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub CopieManquant()
Dim c As Range, v As Range
With Sheets("Feuil2")
    For Each c In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        With Sheets("Feuil1")
            Set v = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Find(c.Value, LookIn:=xlValues, lookat:=xlWhole)
            If v Is Nothing Then c.Copy .Cells(Rows.Count, 1).End(xlUp)(2)
        End With
    Next c
End With
End Sub

Adapte les noms des feuilles

[PPz78]

Si j'ai bien compris le besoin et l'exemple, il suffit de recopier le contenu de la colonne 1 de la feuille 2 dans la colonne 1 de la feuille 1.

PPz

[Pierre67]

Bonjour et un grand merci à MERCATOG,

cela fonctionne très bien.
je cherche à mettre une ligne vierge entre la liste d'origine et la liste des noms manquants.
Mais je ne vois pas du tout où placer et écrire ce bout de code ?
si quelqu'un a une idée
merci
bon dimanche

pour répondre à PPz78, ce n'est pas simplement une recopie. Ce serait trop facile.
ma première liste sert à assurer un suivi différent des noms de la liste des noms manquants

[mercatog]

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
Sub CopieManquant()
Dim c As Range, v As Range
Dim newLig As Long
 
newLig = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row + 2
With Sheets("Feuil2")
    For Each c In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        With Sheets("Feuil1")
            Set v = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Find(c.Value, LookIn:=xlValues, lookat:=xlWhole)
            If v Is Nothing Then
                c.Copy .Range("A" & newLig)
                newLig = newLig + 1
            End If
        End With
    Next c
End With
End Sub

[Pierre67]

j'ai contourné le problème en rajoutant un caractère alt+255 dans la ligne de séparation
pas top mais ça marche

[PPz78]

Il faut faire cela au tout début de la macro.
Mais comme la macro cherche le dernier élément de la liste, il est préférable de mettre une chaîne de caractère de séparation comme
'----------

PPz

[Pierre67]

merci aux contributeurs
Heureusement que vous êtes là pour apporter vos excellents conseils aux néophytes dont je fait partie.
Un grand merci.
pour vous faire comprendre mon projet je vous joins mon fichier.
Fichier : 2 feuilles ; Fbase qui sert à créer les autres, CAL : la feuille calendrier.
par semaine j'extraie une première liste de ceux qui sont d'astreinte puis complète chaque feuille de semaine par ceux qui ne le sont pas.
Pour l'instant test sur 3 feuilles.

lancer la macro création_feuilles
merci encore

avec le fichier c'est mieux (excel 2010)

[mercatog]

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
Sub Creation_feuilles()
Dim sht As Worksheet
Dim NomFeuille As String
Dim i As Integer, Za As Integer, DerniereLigne As Integer, LigneDebut As Integer
Dim Col As Byte
 
Application.ScreenUpdating = False
For i = 4 To 8 Step 2
    NomFeuille = Sheets("CAL").Range("A" & i).Value
    If Len(NomFeuille) > 0 Then
        On Error Resume Next
        Set sht = Sheets(NomFeuille)
        On Error GoTo 0
        If Not sht Is Nothing Then
            If MsgBox("La feuille " & NomFeuille & " existe déjà, voulez vous la remplacer?", vbYesNo + vbDefaultButton2 + vbCritical) = vbYes Then
                Application.DisplayAlerts = False
                sht.Delete
                Application.DisplayAlerts = True
                Set sht = Nothing
            End If
        End If
 
        If sht Is Nothing Then
            Sheets("Fbase").Copy After:=Sheets(Int(i / 2) - 1)
            ActiveSheet.Name = NomFeuille
            LigneDebut = 6
            For Col = 6 To 9
                For Za = i To i + 1
                    If Trim(Sheets("CAL").Cells(Za, Col).Value) <> "" Then
                        Range("A" & LigneDebut).Value = Sheets("CAL").Cells(Za, Col).Value
                        LigneDebut = LigneDebut + 1
                    End If
                Next Za
            Next Col
            DerniereLigne = LigneDebut
            With Sheets("CAL")
                For Each c In .Range("B48:B65")
                    Set v = Range("A:A").Find(c.Value, LookIn:=xlValues, lookat:=xlWhole)
                    If v Is Nothing Then Cells(Rows.Count, 1).End(xlUp)(2).Value = c.Value
                Next c
            End With
            Rows(DerniereLigne).Insert
            Rows(DerniereLigne).Interior.ColorIndex = 24
            Columns(1).AutoFit
        End If
    End If
    Set sht = Nothing
Next i
End Sub

[Pierre67]

Re Mercatog

je n'ai pas envoyé mon fichier pour une réécriture de ma macro.
Bien évidemment la nouvelle version est classe.
Très pro, trop pro pour moi

La mienne fonctionnait
Il est vrai que je ne déclare pas les variables, pas de tests d'erreur, ......... mais ..... souvent j'arrive à m'en sortir grâce aux divers forums sources de bouts de code très utile qui mis bout à bout m'aident à créer mes macros
Merci encore pour tout

[mercatog]

Désolé pour les petites modifications que je me suis permis d'apporter à ton code sans ton consentement explicite. J'avais mal interprété la mise en PJ du fichier.

Il est vrai que je ne déclare pas les variables,

Il est temps de prendre l'habitude de déclarer proprement ses variables.

[Pierre67]

Non je te remercie
je vois que j'ai encore un long chemin à parcourir.Ce ne sont pas des petites modifs c'est une réécriture complète
En tous cas chapeau merci
Merci les animateurs des ces forums pour passer vos dimanches à règler nos problèmes
A bientôt pour d'autres questions