Discussion :

[Lighteux26]

Hello la comunauté

Sur ce fichier réduit (A la base il y'a plus de 20000 lignes)

Je souhaiterais exporter le sdonnées de cellules dont certaines ont des formules.

Premier soucis:
Les données s'exportent bien, sauf que dés qu'il y'a la plage avec les formules, j'ai un soucis de "#REF!"

Second soucis :
Le code est super lent d'éxécution, il faut dans mon classeur et pour ces 75 choix, pret de 30 secondes.

Voici la procédure :

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
Option Explicit
 
Sub ExportChoix()
 
Dim wsBase As Worksheet
Dim wsChoix As Worksheet
Dim lastRowBase As Long, lastRowChoix As Long, i As Long, j As Long
 
' Spécifier les feuilles de calcul
Set wsBase = ThisWorkbook.Sheets("Base")
Set wsChoix = ThisWorkbook.Sheets("Choix")
 
' Trouver la dernière ligne dans la colonne O de la feuille "Base"
lastRowBase = wsBase.Cells(wsBase.Rows.count, "O").End(xlUp).Row
 
Application.ScreenUpdating = False
 
 
' Supprimer les lignes de A5 à la dernière ligne dans les colonnes A à AB
wsChoix.Range("A5:AB" & lastRowBase).Delete
 
' Réinitialiser le compteur de lignes pour la feuille "Choix"
lastRowChoix = 5
 
' Parcourir la colonne "O" à partir de la ligne 5 jusqu'à la dernière ligne de la feuille "Base"
For i = 5 To lastRowBase
    ' Vérifier si la valeur dans la colonne "O" est égale à 0, 1, 2, 3, 4, 5 ou 6
    If wsBase.Cells(i, "O").Value >= "1" And wsBase.Cells(i, "O").Value <= "7" Then
        ' Copier la plage de cellules de A:O dans la feuille "Base" vers la feuille "Choix"
        wsBase.Range("A" & i & ":O" & i).Copy Destination:=wsChoix.Range("A" & lastRowChoix)
        lastRowChoix = lastRowChoix + 1 ' Incrémenter le compteur de lignes pour la feuille "Choix"
    End If
Next i
 
' Si aucune ligne n'est copiée, afficher un message
If lastRowChoix = 5 Then
    MsgBox "Aucun choix n'a été effectué.", vbInformation
Else
    MsgBox "Export de " & (lastRowChoix - 5) & " choix effectué.", vbInformation
End If
 
Application.ScreenUpdating = True
 
AppliquerFormule_Choix
 
End Sub

Et je vous met le fichier avec des données réduites.

Je vous remercie beaucoup

Passez une bonne soirée.

LeLightuex26

[Lighteux26]

Hello

J'ai tenté de faire une copie SpecialCells(xlCellTypeVisible)

Mais cela ne change rien, en revanche la le code s'éxécute plus vite, lol.

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
Sub ExportChoix()
    Dim wsBase As Worksheet
    Dim wsChoix As Worksheet
    Dim lastRowBase As Long, i As Long, j As Long, lastRowChoix As Long
 
    ' Spécifier la feuille de calcul
    Set wsChoix = ThisWorkbook.Sheets("Choix")
    ' Définir les feuilles de travail
    Set wsBase = ThisWorkbook.Sheets("Base")
    ' Trouver la dernière ligne de la colonne "O" de la feuille "Base"
    lastRowBase = wsBase.Cells(wsBase.Rows.Count, "O").End(xlUp).Row
 
    ' Trouver la dernière ligne dans la colonne A de la feuille "Choix"
    lastRowChoix = wsChoix.Cells(wsChoix.Rows.Count, "A").End(xlUp).Row
 
    ' Supprimer les lignes de A5 à la dernière ligne dans les colonnes A à AB de la feuille "Choix"
    wsChoix.Range("A5:AB" & lastRowChoix).Delete
 
    ' Réinitialiser le compteur de lignes pour la feuille "Choix"
    lastRowChoix = 5
 
 
    ' Parcourir la colonne "O" à partir de la ligne 1 jusqu'à la dernière ligne
    For i = 5 To lastRowBase
        ' Vérifier si la valeur dans la colonne "O" est égale à 1, 2, 3, 4, 5, 6 ou 7
        If wsBase.Cells(i, "O").Value >= "1" And wsBase.Cells(i, "O").Value <= "7" Then
            ' Filtrer les cellules visibles dans la plage de cellules "A:O" de la ligne i de la feuille "Base"
            wsBase.Rows(i).Columns("A:O").SpecialCells(xlCellTypeVisible).Copy Destination:=wsChoix.Cells(lastRowChoix, 1)
            lastRowChoix = lastRowChoix + 1
        End If
    Next i
 
    ' Si aucune ligne n'est copiée, afficher un message
    If lastRowChoix = 0 Then
        MsgBox "Aucun choix n'a été effectué.", vbInformation
    Else
        MsgBox "Export de " & lastRowChoix - 5 & " choix effectué.", vbInformation
    End If
 
AppliquerFormule_Choix
 
End Sub

Merci

Bonne journée

lighteux26

[Nain porte koi]

Hello,

Premier soucis:
Les données s'exportent bien, sauf que dés qu'il y'a la plage avec les formules, j'ai un soucis de "#REF!"

C'est un peu normal si vous copiez des formules qui ont des adresses relatives.
Utilisez le collage spécial valeur (PasteSpecial Paste:=xlPasteValues)

[Lighteux26]

Nain porte koi Nain porte koi, le fofo

Merci

Je regarde cela.

Merci, bonne soirée.