XL 2016 copier cellule tableau

[djiska]

Bonjour

Je tente de copier les contenus d'une certaine colonne (feuille 1) dans une colonne (feuille) seulement si les contenus de leurs premières colonnes sont identiques.
mon code marche mais certaines cellules restent vides.
pourriez-vous m'aider à corriger mon erreur ?

Merci

 

[vgendron]

Hello

Je ne comprend pas trop quel est le but de l'opération?
c'est un "extract" de la feuille origine, juste pour le semestre 4 ? (rqe: une année = 2 semestres.. :-D)
tu veux juste récupérer le 4eme semestre des numéros de la feuille destination?

à quoi sert ta boucle While ?? compter le nombre de lignes dans la feuille Destination??

selon ce que tu souhaites faire.. j'ai l'impression que ton code "Tombe en marche"..
que se passe t il si deux numéros sont différents d'une feuille à l'autre, , mais sur la meme ligne ??

 

[vgendron]

un essai avec ce code

Sub extraire()

Dim WsOri As Worksheet
Dim WsDest As Worksheet
Dim TabData() As Variant
Dim TabFinal() As Variant
Dim fin, i, LastLine As Long


Set WsOri = Sheets("origine")
Set WsDest = Sheets("destination")
  
With WsOri
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabData = .Range("A3:G" & fin).Value
End With
    
With WsDest
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabFinal = .Range("A3:E" & fin).Value
End With

LastLine = WorksheetFunction.Min(UBound(TabData, 1), UBound(TabFinal, 1))
For i = LBound(TabData) To LastLine
    If TabData(i, 1) = TabFinal(i, 1) Then
        TabFinal(i, 4) = TabData(i, 6)
    End If
Next i

With WsDest
    .Range("A3").Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)) = TabFinal
    
End With

End Sub

 

[vgendron]

meme code avec interaction utilisateur pour demander le numéro du trimestre à récupérer

Sub extraire()

Dim WsOri As Worksheet
Dim WsDest As Worksheet
Dim TabData() As Variant
Dim TabFinal() As Variant
Dim fin, i, LastLine As Long
Dim NuméroTrimestre As Variant

Set WsOri = Sheets("origine")
Set WsDest = Sheets("destination")

NuméroTrimestre = Application.InputBox("donnez le numéro du trimestre à récuperer")
If IsNumeric(NuméroTrimestre) Then
    If NuméroTrimestre > 4 Then
        MsgBox ("Entrée invalide")
        Exit Sub
    End If
Else
    MsgBox ("Entrée invalide")
    Exit Sub
End If
With WsOri
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabData = .Range("A3:G" & fin).Value
End With
    
With WsDest
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabFinal = .Range("A3:E" & fin).Value
End With

LastLine = WorksheetFunction.Min(UBound(TabData, 1), UBound(TabFinal, 1))
For i = LBound(TabData) To LastLine
    If TabData(i, 1) = TabFinal(i, 1) Then
        TabFinal(i, 4) = TabData(i, NuméroTrimestre + 2)
    End If
Next i

With WsDest
    .Range("A3").Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)) = TabFinal
End With

End Sub

 

[vgendron]

et une solution par dictionnaire pour t'affranchir du besoin d'avoir les memes numéros sur les memes lignes

Sub extraire2()
Dim WsOri As Worksheet
Dim WsDest As Worksheet

Dim fin, i, j, LastLine As Long
Dim NuméroTrimestre As Variant
Dim ListeTrim, Clé As String

Set WsOri = Sheets("origine")
Set WsDest = Sheets("destination")


Dim DicoOri As New Dictionary 'on déclare un dictionnaire


NuméroTrimestre = Application.InputBox("donnez le numéro du trimestre à récuperer")
If IsNumeric(NuméroTrimestre) Then
    If NuméroTrimestre > 4 Then
        MsgBox ("Entrée invalide")
        Exit Sub
    End If
Else
    MsgBox ("Entrée invalide")
    Exit Sub
End If

With WsOri 'dans la feuille Origine
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne
    For i = 3 To fin 'pour chaque ligne
        ListeTrim = "" 'intialisation de la variable
        Clé = .Range("A" & i) 'clé du dictionnaire= numéro
        If Not DicoOri.Exists(Clé) Then 'si l'entrée n'existe pas encore
            For j = 1 To 4 'on concatène les 4 trimestres dans une chaine de caractères - séparés par /
                ListeTrim = ListeTrim & "/" & .Cells(i, j + 2)
            Next j
            DicoOri.Add Clé, ListeTrim 'on créé l'entrée dans le dictionnaire
        End If
    Next i
End With
    
With WsDest 'dans la feuille destination
    .Range("D2") = NuméroTrimestre 'on met à jour la cellule D2
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne
    For i = 3 To fin 'pour chaque ligne
        Clé = .Range("A" & i) 'clé du dictionnaire= numéro
        If DicoOri.Exists(Clé) Then 'si le numéro existe bien dans le dictionnaire  = existe bien dans la feuille Origine
            .Range("D" & i) = Split(DicoOri(Clé), "/")(NuméroTrimestre) 'on récupère le trimestre souhaité pour le mettre dans la colonne D
        End If
    Next i
End With
End Sub

 

[djiska]

Bonjour @vgendron

oui en effet il s'agissait de copier les valeurs pour les semestre 4.
de l'origine vers la destination si les valeurs de la première colonne sont identiques.

Merci beaucoup de ton aide
c'est très apprécié

 

[Jacky67]

Bonjour @vgendron

oui en effet il s'agissait de copier les valeurs pour les semestre 4.

Bonjour à tous
Une autre proposition avec possibilité de changement de trimestre

Sub maj()
    Dim Derlg&
    With Feuil2
        Derlg = .Cells(.Rows.Count, "A").End(xlUp).Row
        If .[d2] = "" Then .Range("d3:d" & Derlg) = "": Exit Sub
        .Range("d3:d" & Derlg).Formula = "=INDEX(origine!$a:$g,MATCH($a3,origine!$a:$a,0),MATCH($d$2,origine!$2:$2,0))"
        .Range("b3:b" & Derlg).Formula = "=INDEX(origine!$b:$b,MATCH($a3,origine!$a:$a,0))"
        .Range("b3:d" & Derlg).Value = .Range("b3:d" & Derlg).Value
    End With
End Sub

 

[djiska]

Merci @Jacky67
c'est très apprecié