Discussion :

[adriennoob]

Là je sèche...

Je voudrais créer un tableau mais je sais pas comment m'y prendre.
Je mets un lien pour que vous puissiez voir mon objectif.

J'ai des champs nom, prénom, famille (pour définir si il existe un lien entre ces personnes), photo individuel, photo famille.

J'aimerais avec ces données créer un tableau qui puissent selon mes données me recréer un tableau avec les champs : nom, prénom/famille.

En fait dans ce tableau selon mes données j'aurais obligatoirement un nom pour faire une photo, mais pas forcément un prénom si c'est une photo de famille.

Ceci permettra au photographe d'optimiser son temps entre deux photos. Il apelera une famille fera des photos individuelles et/ou une photo de famille.

J'ai mis a peu près le résultat que je souhaite manuellement.

Donc avis au idées.

[adriennoob]

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
Private Sub dezr()
 
    Dim Plage As Range, Cellules As Range, Cellules1 As Range
    Dim bytMois As Byte
    Dim intAnnee As Integer
    Dim recup As String
 
    With Worksheets("Feuil1")
 
    For Each Cellules1 In Worksheets("Feuil1").Range("K4:k" & .Range("k" & .Rows.Count).End(xlUp).Row)
 
        Set Plage = Nothing
 
        For Each Cellules In Worksheets("Feuil1").Range("B4:b" & .Range("b" & .Rows.Count).End(xlUp).Row)
                If Cellules = Cellules1 And Cellules(1, 2) = "Martin" Then
                    If Plage Is Nothing Then
                        Set Plage = Cellules
                    Else
                        Set Plage = Union(Plage, Cellules)
                    End If
                   recup = Cellules.Value
                End If
        Next Cellules
 
 
        If Not Plage Is Nothing Then
 
        If Plage.Count < 2 Then
 
        Application.CutCopyMode = True
        Plage.Copy
 
        With Worksheets("Feuil3")
        Worksheets("Feuil3").Select
        ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Rows.Count + 1, ActiveSheet.UsedRange.Columns.Count).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        End With
        Else
    With Worksheets("Feuil3")
        Worksheets("Feuil3").Select
        Application.CutCopyMode = True
        Plage.Copy
        ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Rows.Count + 1, ActiveSheet.UsedRange.Columns.Count).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Rows.Count + 1, ActiveSheet.UsedRange.Columns.Count).Value = recup
        End With
        End If
 
        End If
 
    Next Cellules1
 
    End With
 
End Sub

bon ben voila, après avoir failli pleuré j'y suis arrivé par mes propres moyens .

Bon ce code n'est peut être pas optimisé mais il fonctionne. Je suis super content.