[Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

[WhiteRabbit]

Bonjour à tous,
Je débute depuis quelques jours sur le VBA et j'ai récupéré il y a peu un fichier dans lequel une macro à pour fonction de parcourir le contenu d'un tableau dans un onglet et en générer un fichier txt bien formé.

La structure de la fonction est assez simple :

Sub CreationCSV(nom)

Application.ScreenUpdating = False
Sheets("temp").Select

' recopie des données du tableau vers l'onglet temporaire

Sheets("S" & nom).Select
Range("B3").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(1, 0).Select
A = ActiveCell.Address


Range("B4").Select
Selection.End(xlDown).Select
b = ActiveCell.Address

Range(A & ":" & b).Select
Selection.Copy
Sheets("temp").Select
Range("A2").Select
If Worksheets("S" & nom).Range("A4").Value = "SAIN" Then
ActiveSheet.Paste
End If

Application.CutCopyMode = False


'écriture de la dernière ligne
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlToLeft).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "Z"
NbLigne = ActiveCell.Row - 2
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = NbLigne

'détermination du nombre de champ dans la table:
Sheets("S" & nom).Select
Range("A3").Select
Selection.End(xlToRight).Select
NbChamp = ActiveCell.Column

If CMP10 = True Then
enregistrementCMP10 nom, NbChamp
Else
enregistrement nom, NbChamp
End If

Sheets("Intro").Select

Application.ScreenUpdating = True
End Sub

J'ai ajouté les deux lignes en bleu afin de créer un filtre qui lorsque la cellule A4 de l'onglet parcouru contient "SAIN" alors la macro colle.

Et je voudrais que lorsque la valeur n'est pas "SAIN" alors la macro passe à une autre cellule et continue de coller ou non.

Le filtre fonctionne bien quand A4 est SAIN, mais dès que je le change, alors la macro bug, et le debugger se place sur la ligne en orange que je n'arrive pas à interpréter.

Dois je ajouter un Else avec une instruction particulière indiquant à la macro de sauter la ligne en cours et de continuer ?

Merci pour votre aide

 

[Compte Supprimé 979]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

Salut WhiteRabbit

Avant de te dépanner, j'aimerais en savori plus ...
tout ce code pour créer un fichier CSV !?

Sinon l'optimisation de ton code, sachant que tu n'est pas obliger de faire des sélections
pour aboutir à un résultat

Sub CreationCSV(nom)
  Dim ShtTmp As Worksheet, Lig As Long, Col As Integer
  Dim DligT As Long, DColT As Integer
  Application.ScreenUpdating = False
  ' Définir l'objet feuille temporaire
  Set ShtTmp = Sheets("temp")
  ' recopie des données du tableau vers l'onglet temporaire
  With Sheets("S" & nom)
    ' Dernière colonne de droite
    Col = .Range("B3").End(xlToRight).Offset(1, 0).Column
    ' Dernière ligne
    Lig = .Range("B4").End(xlDown).Row
    
    If .Range("A4").Value = "SAIN" Then
      .Range(Cells(3, Col), Cells(Lig, Col)).Copy Destination:=ShtTmp.Range("A2")
    End If
    Application.CutCopyMode = False
  ' Ecriture de la dernière ligne
  DligT = ShtTmp.Range("A1").End(xlDown).Row
  DColT = ShtTmp.Range("A1").End(xlToLeft).Column
  ShtTmp.Cells(DligT + 1, DColT).Value = "Z"
  ShtTmp.Cells(DligT + 1, DColT + 1).Value = DligT
  ' Avec la feuille "S" & Nom)
  ' détermination du nombre de champ dans la table:
  nbchamp = .Range("A3").End(xlToRight).Column
  
  If CMP10 = True Then
    enregistrementCMP10 nom, nbchamp
  Else
    enregistrement nom, nbchamp
  End If
  Sheets("Intro").Select
  Application.ScreenUpdating = True
End Sub

A+

 

[WhiteRabbit]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

Bonjour Bruno,

Alors pour répondre à ta première question, "pq tout ce code" en fait c'est parce que la fonction d'export a été conçue pour ne prendre dans un onglet que le contenu d'un tableau commençant dans la colonne B4; s'étendant en largeur jusqu'à la fin d'un nombre de colonne dépendant des cellules présentes sur la ligne 3.

D'où la complexité du début de ma fonction.

Je ne sais pas si je suis super clair.
En lisant ta proposition d'optimisation, je ne vois pas de notion dans le cas où A4 n'est pas SAIN.
Que ce passe t il alors?

 

[WhiteRabbit]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

Rahh je viens de comprendre que le code d'origine ne bouclait pas ligne par ligne pour effectuer la recopie dans l'onglet temp.

Je ne peux donc pas tester A4 pour chaque ligne (puisqu'à terme je veux un test par ligne).

 

[Compte Supprimé 979]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

Re,

Ok compris, essaye ce code

Sub CreationCSV(nom)
Dim ShtTmp As Worksheet, DCol As Integer, DLig As Long, Lig As Long
Dim DligT As Long, DColT As Integer
Application.ScreenUpdating = False
' Définir l'objet feuille temporaire
Set ShtTmp = Sheets("temp")
' recopie des données du tableau vers l'onglet temporaire
With Sheets("S" & nom)
' Dernière colonne de droite
DCol = .Range("B3").End(xlToRight).Offset(1, 0).Column
' Dernière ligne
DLig = .Range("B4").End(xlDown).Row
' Pour chaque ligne
For Lig = 4 To DLig
If .Range("A" & lig).Value = "SAIN" Then
DligT = ShtTmp.Range("A" & Rows.Count).End(xlUp).Row
.Range(Cells(3, Col), Cells(Lig, Col)).Copy Destination:=ShtTmp.Range("A" & DligT + 1)
Application.CutCopyMode = False
End If
Next
' Ecriture de la dernière ligne
DligT = ShtTmp.Range("A1").End(xlDown).Row
DColT = ShtTmp.Range("A1").End(xlToLeft).Column
ShtTmp.Cells(DligT + 1, DColT).Value = "Z"
ShtTmp.Cells(DligT + 1, DColT + 1).Value = DligT
' Avec la feuille "S" & Nom)
' détermination du nombre de champ dans la table:
nbchamp = .Range("A3").End(xlToRight).Column
End With
 
If CMP10 = True Then
enregistrementCMP10 nom, nbchamp
Else
enregistrement nom, nbchamp
End If
Sheets("Intro").Select
Application.ScreenUpdating = True
End Sub

A tester et vérifier

A+

 

[WhiteRabbit]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

merci pour ton retour rapide,

ça me dit au débug qu'il manque un End With

 

[Compte Supprimé 979]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

Re,

Correction effectuée dans code au dessus

A+

 

[WhiteRabbit]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

Maintenant il s'arrete sur ta ligne
If .Range("A" & li).Value = "SAIN" Then


avec l'erreur suivante: erreur 1004
Erreur definie par l'application ou par l'objet

 

[Compte Supprimé 979]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

Re,

Essaye d'avoir un minimum de réflexion STP

If .Range("A" & Lig).Value = "SAIN" Then

A+

 

[WhiteRabbit]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

J'avais en effet remplacé le li par Lig et il s'arrête alors sur la ligne du dessous :
.Range(Cells(3, Col), Cells(Lig, Col)).Copy Destination:=ShtTmp.Range("A" & DligT + 1)

Je n'arrive pas à te suivre sur cette ligne avec les variables "Col" ?
Où sont elles initialisées et pq les utilises tu?

Merci de ta patience et encore désolé

 

[Compte Supprimé 979]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

Désolé,

N'ayant pas Excel sous a main, j'ai fait le code a la oneagain

Col c'est transformé en DCol, car apparemment dans ton code tu allais chercher la dernère colonne

Sub CreationCSV(nom)
Dim ShtTmp As Worksheet, DCol As Integer, DLig As Long, Lig As Long
Dim DligT As Long, DColT As Integer
Application.ScreenUpdating = False
' Définir l'objet feuille temporaire
Set ShtTmp = Sheets("temp")
' recopie des données du tableau vers l'onglet temporaire
With Sheets("S" & nom)
' Dernière colonne de droite
DCol = .Range("B3").End(xlToRight).Offset(1, 0).Column
' Dernière ligne
DLig = .Range("B4").End(xlDown).Row
' Pour chaque ligne
For Lig = 4 To DLig
If .Range("A" & Lig).Value = "SAIN" Then
DligT = ShtTmp.Range("A" & Rows.Count).End(xlUp).Row
.Range(Cells(3, DCol), Cells(Lig, DCol)).Copy Destination:=ShtTmp.Range("A" & DligT + 1)
Application.CutCopyMode = False
End If
Next
' Ecriture de la dernière ligne
DligT = ShtTmp.Range("A1").End(xlDown).Row
DColT = ShtTmp.Range("A1").End(xlToLeft).Column
ShtTmp.Cells(DligT + 1, DColT).Value = "Z"
ShtTmp.Cells(DligT + 1, DColT + 1).Value = DligT
' Avec la feuille "S" & Nom)
' détermination du nombre de champ dans la table:
nbchamp = .Range("A3").End(xlToRight).Column
End With
If CMP10 = True Then
enregistrementCMP10 nom, nbchamp
Else
enregistrement nom, nbchamp
End If
Sheets("Intro").Select
Application.ScreenUpdating = True
End Sub

A+

 

[WhiteRabbit]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

Merci je test demain, je n'ai plus accès au fichier !

Merci encore pour ton aide

 

[WhiteRabbit]

Re : [Macro] Filtrer la sélection de ligne dans une macro qui parcourt des lignes

Yes Bruno ça fonctionne !
En mixant des morceaux de ton code et du miens, je suis parvenu à ce que je souhaitais.

Merci bcp pour ton aide ! (et désolé pour les questions un peu bête)