an@s
XLDnaute Occasionnel
Bonsoir à tous,
dans l'exemple ci-joint j'essaie de faire l'importation des données de feuille Balance vers le classeur CB à partir de la cellule A8.
en plus de ça pour chaque ligne importée je saisie un code manuellement dans la colonne F et quand je fais l'importation une deuxième fois le code importe les nouvelles lignes et garde les anciennes avec le même code.
le problème sur mon exemple c'est que je n'ai pas une seule colonne de référence sans doublons, mais pour éviter cela il faut considérer trois colonnes A, C et D chose qui m'empêche d'appliquer le même code ci-dessous produit par JOB dans un exemple similaire.
Merci d'avance
An@s
dans l'exemple ci-joint j'essaie de faire l'importation des données de feuille Balance vers le classeur CB à partir de la cellule A8.
en plus de ça pour chaque ligne importée je saisie un code manuellement dans la colonne F et quand je fais l'importation une deuxième fois le code importe les nouvelles lignes et garde les anciennes avec le même code.
le problème sur mon exemple c'est que je n'ai pas une seule colonne de référence sans doublons, mais pour éviter cela il faut considérer trois colonnes A, C et D chose qui m'empêche d'appliquer le même code ci-dessous produit par JOB dans un exemple similaire.
Merci d'avance
An@s
VB:
Private Sub CommandButton1_Click()
Dim t, nlig&, d As Object, i&, rest(), j&
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Paie-Mens.xlsx").Sheets("Feuil1")
t = .Range("A5:AC" & .Range("F" & .Rows.Count).End(xlUp).Row + 2)
nlig = UBound(t)
.Parent.Close False
End With
'---restitution du 1er tableau---
[E:E].Copy [AE1] 'sauvegarde la colonne E (matricules) en colonne auxiliaire AE
Range("A3:AC" & Rows.Count).ClearContents 'RAZ
[A3].Resize(nlig, 29) = t
'---liste des noms du 1er tableau---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
If t(i, 5) <> "" Then d(t(i, 5)) = i 'repère la ligne
Next i
'---création du 2ème tableau (rest)---
t = Range("AD3:AE" & Range("AE" & Rows.Count).End(xlUp).Row + 1)
ReDim rest(1 To nlig, 1 To 1)
For i = 1 To UBound(t)
If t(i, 2) <> "" And d.Exists(t(i, 2)) Then rest(d(t(i, 2)), 1) = t(i, 1)
Next i
'---restitution du 1er tableau rest---
[AE:AE].Delete 'à l'origine on a mis des formules en colonne AE
Range("AD3:AD" & Rows.Count).ClearContents 'RAZ
[AD3].Resize(nlig) = rest
'---Bordures---
Rows("3:" & Rows.Count).Borders.LineStyle = xlNone 'RAZ
For i = nlig To 1 Step -1
If Range("D" & i + 2) <> "" Then 'dernière ligne effective
[A3].Resize(i, 30).Borders.Weight = xlThin
[A3].Resize(i, 30).Borders(xlInsideHorizontal).LineStyle = xlDot
'[A3].Resize(i, 30).Borders(xlInsideHorizontal).Weight = xlHairline 'si l'on préfère
Exit For
End If
Next i
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
End Sub