Discussion :

[vba_lieb]

Bonjour,

je cherche en vain à trouver la solution.
J'ai dans une variable ma ligne. Par exemple var_ligne

J'ai des infos dans cette ligne de la colonne F à la K des cellules avec des informations.
Je voudrais les récupérer et les copie dans une nouvelle feuille. Son nom : DESTINATION

Toutefois, dans cette même ligne colonne F à K, j'ai des cellules qui commence par le chiffre 7 et d'autre nom.
Je voudrais récupérer donc uniquement les cellules qui commencent du chiffre 7 et les copié dans la feuille DESTINATION

Voilà pour mon souci.

merci pour votre aide.

Editer ce jour :

Alors pour vous montrer mon début de travail, voici le code :

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
--------- DECLARATION EMPLACEMENT FICHIER : ARCHIVES_LIEBHERR1_V1.4.xlsx ---------
'On déclare le fichier source de donnée ARCHIVES
Dim FILE_ARCHIVES As String
FILE_ARCHIVES = "METTRE_ICI_CHEMINET_NOM_FICHIER_ET_EXTENSION"
 
'On déclare la variable qui contiendra la référence du fichier ARCHIVES_LIEBHERR1_V1.4.xlsx
Dim WbArchive As Workbook
'On ouvre le fichier Archives
Set WbArchive = Workbooks.Open(FILE_ARCHIVES)
 
'On déclare la feuille source dans le fichier ARCHIVES LIEBHERR1
Dim WcArchive As Worksheet
Set WcArchive = WbArchive.Worksheets("ARCHIVES")
 
 
'----     COPIE DES TACHES QUI SONT DANS ARCHIVES VERS FEUILLE GESTION EXECUTANT ET COMMENCANT PAR LE CHIFFRE 7     ------
Dim WcEXECUTANT_TACHE As Worksheet
Set WcEXECUTANT_TACHE = WbArchive.Worksheets("GESTION_EXECUTANT")
 
' ---  ETAPE 1 : On identifie la derniere ligne dans le classeur GESTION_EXECUTANT d'ARCHIVES_LIEBHERR  ---
        Dim LigneOF_Gestion_Executant As String
        LigneOF_Gestion_Executant = WcEXECUTANT_TACHE.Range("B" & WcEXECUTANT_TACHE.Rows.Count).End(xlUp).Row + 1
        'MsgBox ("LA DERNIERE LIGNE A UTLISER DANS GESTION_EXECUTANT EST LIGNE : " & LigneOF_Gestion_Executant), 48, "MESSAGE POUR DEVELOPPEUR"
 
' ---  ETAPE 1.1 : On identifie la colonne libre TACHE de la derniere ligne dans GESTION_EXECUTANT d'ARCHIVES_LIEBHERR  ---
'        Dim COLONNE_TACHE_LIBRE As String
'        COLONNE_TACHE_LIBRE = WcEXECUTANT_TACHE.Columns("F" & WcEXECUTANT_TACHE.Columns.Count).End(xlUp).Row + 1
'        MsgBox ("LA PREMIERE COLONNE DISPONIBLE DES TACHES EST : " & COLONNE_TACHE_LIBRE), 48, "MESSAGE POUR DEVELOPPEUR"

Alors déjà, je ne sais pas comment on peut vérifier une colonne si elle est vide d'une ligne, J'ai un début d'ébauche que j'ai commenté :

Code :

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

1
2
3
4
' ---  ETAPE 1.1 : On identifie la colonne libre TACHE de la derniere ligne dans GESTION_EXECUTANT d'ARCHIVES_LIEBHERR  ---
'        Dim COLONNE_TACHE_LIBRE As String
'        COLONNE_TACHE_LIBRE = WcEXECUTANT_TACHE.Columns("F" & WcEXECUTANT_TACHE.Columns.Count).End(xlUp).Row + 1
'        MsgBox ("LA PREMIERE COLONNE DISPONIBLE DES TACHES EST : " & COLONNE_TACHE_LIBRE), 48, "MESSAGE POUR DEVELOPPEUR"

Je continue mon investigation dans tous les cas.

Je joins un fichier d'exemple avec la mise à jour de mon message :
TEST_ARCHIVES.xlsx

Merci encore pour votre coup de main

[Franc]

Salut, si je m'en tiens à l'énoncé de ton problème, cette macro devrait t'aider. Je te laisse le soin de l'adapter à tes besoins.

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
Sub CopierCellulesCommencantPar7()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim var_ligne As Long
    Dim i As Integer
    Dim colIndex As Integer
    Dim destRow As Long
 
    ' Définir la ligne source
    var_ligne = 5 ' Remplace par la ligne souhaitée (par exemple 5 ici)
 
    Set wsSource = ThisWorkbook.Sheets("Sheet1") ' Remplace par le nom de ta feuille source
    On Error Resume Next
    Set wsDest = ThisWorkbook.Sheets("DESTINATION")
    On Error GoTo 0
 
    ' Si la feuille DESTINATION n'existe pas, on la crée
    If wsDest Is Nothing Then
        Set wsDest = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsDest.Name = "DESTINATION"
    End If
 
    ' Définir la première ligne vide dans DESTINATION
    destRow = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row + 1
 
    ' Parcourir les colonnes F à K de la ligne var_ligne
    For colIndex = 6 To 11 ' Colonnes F (6) à K (11)
        ' Vérifier si la cellule commence par 7
        If Left(wsSource.Cells(var_ligne, colIndex).Value, 1) = "7" Then
            ' Copier la valeur dans la feuille DESTINATION
            wsDest.Cells(destRow, colIndex - 5).Value = wsSource.Cells(var_ligne, colIndex).Value
        End If
    Next colIndex
 
    MsgBox "Les valeurs commençant par 7 ont été copiées dans la feuille DESTINATION !"
End Sub

[vba_lieb]

EDIT DU 02/10/2024
Le problème des cellules vides si une TACHE commencent pas par 7 dans DESTINATION est réglé (Voir le code dont j'ai commenté)




Bonjour,

Alors après une matinée de recherche, j'ai réussi car ton aide m'a permis une belle avancée.

Il y a dans le code des MsgBox qui sont commentés, c'était pour comprendre ce qu'il se passé avec les variables. Je les ai laissé en cas de besoin.

Toutefois, j'ai un souci que j'arrive pas à régler :
Les taches commençant par 7 s'écrive bien, mais celle éliminé car ça commence pas par 7 génère une cellule vide dans DESTINATION (voir image ci-dessous)



Pour info, je fourni ici le nouveau fichier car j'ai effectué quelques modifs mineures pour les tests :
TEST_ARCHIVES.xlsm

UPDATE DU CODE pour le probléme de la suppression des cellules vides (Voir Quote ci-dessus)

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
58
59
Sub Executant()
 
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim Ligne_Source As Long
    Dim i As Integer
    Dim colIndex As Integer
    Dim destRow As Long
    Dim find_OF_Ligne As Integer
 
' Définir la premiere ligne source
    'Ligne_Source = 4 ' Remplace par la ligne souhaitée (par exemple 5 ici)
 
    Set wsSource = ThisWorkbook.Sheets("SOURCE") 'Mettre ici le nom de ta feuille source
    On Error Resume Next
 
    Set wsDest = ThisWorkbook.Sheets("DESTINATION") 'Mettre ici le nom de ta feuille Destination
    On Error GoTo 0
 
With wsSource
    'On fait commencer la boucle à partir de la ligne 4 (To 4 Step -1)
    For find_OF_Ligne = wsSource.Range("B" & .Rows.Count).End(xlUp).row To 4 Step -1
    VALEUR_CELLULE = wsSource.Cells(find_OF_Ligne, "B").Value
    'MsgBox ("Feuille Source la ligne de l'OF est :  " & find_OF_Ligne & ", et la valeur cellule est : " & VALEUR_CELLULE)
 
    ' Définir la première ligne vide dans DESTINATION
    destRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).row + 1
    'MsgBox ("Feuille DESTINATION, la premiere ligne vide est : " & destRow)
 
    'iColumn sert pour identifier la colonne libre de la ligne en cours
    'On affecte 5 à iColumn pour écrire à partir de la colonne 6
    iColumn = 5
 
    ' Dans SOURCE, on indique la plage de colonnes ou sont les taches
    For colIndex = 3 To 12 ' Colonnes C (3) à L (12)
            'MsgBox ("Onglet Source : TACHE - N° de colonne  : " & colIndex)
 
            'On copie le numéro OF dans DESTINATION
            wsDest.Cells(destRow, "B").Value = VALEUR_CELLULE
 
            'Puis on vérifie si la tache commence par le chiffre 7
            'Et si oui, je copie la tache dans DESTINATION + j'incrémente de 1 iColumn
            If Left(wsSource.Cells(find_OF_Ligne, colIndex).Value, 1) = "7" Then
                wsDest.Cells(destRow, iColumn + 1).Value = wsSource.Cells(find_OF_Ligne, colIndex).Value
                iColumn = iColumn + 1
            End If
        Next colIndex
    Next find_OF_Ligne
End With
 
    MsgBox "Les valeurs commençant par 7 ont été copiées dans la feuille DESTINATION !"
 
    'On libére les ressources
    iColumn = 0
    destRow = 0
    colIndex = 0
    VALEUR_CELLULE = 0
    find_OF_Ligne = 0
End Sub

J'y suis enfin presque !
Reste donc du coup 1 points qui est :

-> Et si N° OF existe déjà, ne pas écrire

Merci pour ton aide

Lieb

[Franc]

Salut, teste comme ceci:

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
Sub Executant()
 
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim Ligne_Source As Long
    Dim i As Integer
    Dim colIndex As Integer
    Dim destRow As Long
    Dim find_OF_Ligne As Long
    Dim VALEUR_CELLULE As String
    Dim rng As Range
    Dim cell As Range
    Dim found As Range
    Dim dataSource As Variant
    Dim dataDest As Variant
    Dim lastRowSource As Long
    Dim lastRowDest As Long
    Dim sourceRowCount As Long
 
    Set wsSource = ThisWorkbook.Sheets("SOURCE")
    Set wsDest = ThisWorkbook.Sheets("DESTINATION")
 
    ' Charger les données de la feuille SOURCE dans un tableau pour un traitement rapide
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).row
    dataSource = wsSource.Range("B4:L" & lastRowSource).Value ' Récupérer toutes les lignes et colonnes nécessaires
 
    ' Définir la première ligne vide dans DESTINATION
    lastRowDest = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).row + 1
 
    ' Charger les données existantes dans DESTINATION pour éviter les recherches répétées
    dataDest = wsDest.Range("B1:B" & lastRowDest).Value ' Récupérer toutes les valeurs existantes dans la colonne B
 
    ' Boucler à travers le tableau des données source (plutôt que les cellules directement)
    For find_OF_Ligne = UBound(dataSource, 1) To 1 Step -1
        VALEUR_CELLULE = dataSource(find_OF_Ligne, 1) ' Colonne B dans SOURCE
 
        ' Vérifier si la valeur existe déjà dans DESTINATION
        If IsError(Application.Match(VALEUR_CELLULE, dataDest, 0)) Then ' Si non trouvé, copier la ligne
            ' Ajouter la valeur dans DESTINATION
            wsDest.Cells(lastRowDest, "B").Value = VALEUR_CELLULE
 
            ' Parcourir les colonnes C à L (3 à 12 dans le tableau)
            For colIndex = 3 To 12
                If Left(dataSource(find_OF_Ligne, colIndex - 1), 1) = "7" Then
                    wsDest.Cells(lastRowDest, colIndex + 3).Value = dataSource(find_OF_Ligne, colIndex - 1)
                End If
            Next colIndex
 
            ' Incrémenter la ligne de destination pour la prochaine ligne copiée
            lastRowDest = lastRowDest + 1
        End If
    Next find_OF_Ligne
 
    MsgBox "Les valeurs commençant par 7 ont été copiées dans la feuille DESTINATION !"
 
End Sub

[vba_lieb]

Parfait,

Après quelques customisation perso, ça fonctionne !

Merci encore

lieb