Bonjour,
dans un 1er temps désolé pour mes oublis de politesse sur les derniers post.
ce code est censé (car il ne fonctionne pas très bien ....) copier les valeurs saisie de mon tableau feuille14 feuille13....... vers le tableau feuille22 SI la colonne L contient une valeur et comparer la colonne B des tableau avant de copier pour éviter les doublon
j'ai recuperer et adapté cette partie de code du "dictionnaire" sur un vieux fichier , c'est peut etre pas une bonne méthode pour trier les doublons car j'ai : erreur de compilation variable non definie sur : For Each cell In rngExist avant l'ajout de cette partie ça fonctionnais tres bien je voulais juste éviter les doublon dans ma destination
merci de votre aide
Sub CopierLignesRemplies()
Dim ws14 As Worksheet, ws13 As Worksheet, ws12 As Worksheet, ws22 As Worksheet
Dim ligne As Long, derniereLigne As Long, nouvelleLigne As Long
Dim dictExist As Object
Set dictExist = CreateObject("Scripting.Dictionary")
' sources
Set ws14 = ThisWorkbook.Worksheets("EST NUIT")
Set ws13 = ThisWorkbook.Worksheets("EST MIXTE")
Set ws12 = ThisWorkbook.Worksheets("EST 6h30-13h45")
'......
'...... total de 22 feuilles identiques
'destination
Set ws22 = ThisWorkbook.Worksheets("Liste retenu")
' recherche dans Feuil14, Feuil13 et Feuil12
derniereLigne = 28 ' Changer la valeur si nécessaire
' destination dans Feuil22
nouvelleLigne = 4 ' Changer la valeur si nécessaire
' test avec dictionnaire avec les valeurs existantes de Feuil22 (colonne B)
Dim rngExist As Range
Set rngExist = ws22.Range("B4:B58")
For Each cell In rngExist
If Not IsEmpty(cell) Then
dictExist(cell.Value) = True
End If
Next cell
' Recherche + copie les lignes de Feuil14 (en évitant les doublons)
For ligne = 4 To derniereLigne
' Vérification colonne L de la ligne actuelle eswt vide
'colonne L : 12
If ws14.Cells(ligne, 12).Value <> "" Then
' Vérifi si la valeur de la colonne B existe déjà dans Feuil22
If Not dictExist.Exists(ws14.Range("B" & ligne).Value) Then
' Copi la ligne dans Feuil22 à la plage de destination
ws14.Range("B" & ligne & ":R" & ligne).Copy ws22.Range("B" & nouvelleLigne)
nouvelleLigne = nouvelleLigne + 1
' Ajouter la valeur au dictionnaire pour éviter les doublons lors des prochaines comparaisons
dictExist(ws14.Range("B" & ligne).Value) = True
End If
End If
Next ligne
'"""""""""""""""
' idem feuilxxxxxx j'ai 22 feuilles identiques donc aucun probleme de format
' message de confirmation ptit lux
MsgBox "Opération terminée ! Les lignes ont été copiées des Feuil14, Feuil13 et Feuil12 à Feuil22, sans doublons.", vbInformation
End Sub
'MERCI de votre aide !!!!!
dans un 1er temps désolé pour mes oublis de politesse sur les derniers post.
ce code est censé (car il ne fonctionne pas très bien ....) copier les valeurs saisie de mon tableau feuille14 feuille13....... vers le tableau feuille22 SI la colonne L contient une valeur et comparer la colonne B des tableau avant de copier pour éviter les doublon
j'ai recuperer et adapté cette partie de code du "dictionnaire" sur un vieux fichier , c'est peut etre pas une bonne méthode pour trier les doublons car j'ai : erreur de compilation variable non definie sur : For Each cell In rngExist avant l'ajout de cette partie ça fonctionnais tres bien je voulais juste éviter les doublon dans ma destination
merci de votre aide
Sub CopierLignesRemplies()
Dim ws14 As Worksheet, ws13 As Worksheet, ws12 As Worksheet, ws22 As Worksheet
Dim ligne As Long, derniereLigne As Long, nouvelleLigne As Long
Dim dictExist As Object
Set dictExist = CreateObject("Scripting.Dictionary")
' sources
Set ws14 = ThisWorkbook.Worksheets("EST NUIT")
Set ws13 = ThisWorkbook.Worksheets("EST MIXTE")
Set ws12 = ThisWorkbook.Worksheets("EST 6h30-13h45")
'......
'...... total de 22 feuilles identiques
'destination
Set ws22 = ThisWorkbook.Worksheets("Liste retenu")
' recherche dans Feuil14, Feuil13 et Feuil12
derniereLigne = 28 ' Changer la valeur si nécessaire
' destination dans Feuil22
nouvelleLigne = 4 ' Changer la valeur si nécessaire
' test avec dictionnaire avec les valeurs existantes de Feuil22 (colonne B)
Dim rngExist As Range
Set rngExist = ws22.Range("B4:B58")
For Each cell In rngExist
If Not IsEmpty(cell) Then
dictExist(cell.Value) = True
End If
Next cell
' Recherche + copie les lignes de Feuil14 (en évitant les doublons)
For ligne = 4 To derniereLigne
' Vérification colonne L de la ligne actuelle eswt vide
'colonne L : 12
If ws14.Cells(ligne, 12).Value <> "" Then
' Vérifi si la valeur de la colonne B existe déjà dans Feuil22
If Not dictExist.Exists(ws14.Range("B" & ligne).Value) Then
' Copi la ligne dans Feuil22 à la plage de destination
ws14.Range("B" & ligne & ":R" & ligne).Copy ws22.Range("B" & nouvelleLigne)
nouvelleLigne = nouvelleLigne + 1
' Ajouter la valeur au dictionnaire pour éviter les doublons lors des prochaines comparaisons
dictExist(ws14.Range("B" & ligne).Value) = True
End If
End If
Next ligne
'"""""""""""""""
' idem feuilxxxxxx j'ai 22 feuilles identiques donc aucun probleme de format
' message de confirmation ptit lux
MsgBox "Opération terminée ! Les lignes ont été copiées des Feuil14, Feuil13 et Feuil12 à Feuil22, sans doublons.", vbInformation
End Sub
'MERCI de votre aide !!!!!
