XL 2013 VBA import de lignes conditionné [Résolu]

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion GuestRC
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
G

GuestRC

Guest
Bonjour à tous!

J'ai une macros qui importe des lignes d'autres feuilles mais je n'ai besoin que des lignes dont la colonne AG2 n'est ni vide ni égale à 0

pour le moment je fais ça:

VB: 
Sub Import_Donnees_Signalement()
    Dim j As Integer, Lignefin As Integer, h As Integer
    Application.ScreenUpdating = False
    Lignefin = 2
    Dim c As Range
    For j = ActiveWorkbook.Worksheets.Count To 8 Step -1
        Worksheets(j).Range("AB2:AB26").Copy
        Worksheets(7).Range("T" & Lignefin).Select
               
        For h = 2 To 26 Step 1
               
        Worksheets(7).Range("T" & Lignefin) = Worksheets(j).Range("AB" & h)
        Worksheets(7).Range("U" & Lignefin) = Worksheets(j).Range("AC" & h)
        Worksheets(7).Range("V" & Lignefin) = Worksheets(j).Range("AD" & h)
        Worksheets(7).Range("W" & Lignefin) = Worksheets(j).Range("AE" & h)
        Worksheets(7).Range("X" & Lignefin) = Worksheets(j).Range("AF" & h)
        Worksheets(7).Range("Y" & Lignefin) = Worksheets(j).Range("AG" & h)
        Worksheets(7).Range("Z" & Lignefin) = Worksheets(j).Range("AH" & h)
        Worksheets(7).Range("AA" & Lignefin) = Worksheets(j).Range("AI" & h)
        Worksheets(7).Range("AB" & Lignefin) = Worksheets(j).Range("AJ" & h)
        Worksheets(7).Range("AC" & Lignefin) = Worksheets(j).Range("AK" & h)
        Worksheets(7).Range("AD" & Lignefin) = Worksheets(j).Range("AL" & h)
        Worksheets(7).Range("AE" & Lignefin) = Worksheets(j).Range("AM" & h)
        Worksheets(7).Range("AF" & Lignefin) = Worksheets(j).Range("AN" & h)
        Worksheets(7).Range("AG" & Lignefin) = Worksheets(j).Range("AO" & h)
        Worksheets(7).Range("AH" & Lignefin) = Worksheets(j).Range("AP" & h)
        Lignefin = Lignefin + 1

        Next h
       
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
       
       
    Next j
End Sub

En gros la fonction parcours toutes les feuilles jusqu'à la feuille 8 et copie des lignes dans la feuille 7. Le problème est qu'une fois importé je dois enlever les lignes inutiles. Mais quand je mets un if ça bug pas mal. il y a des trous dans le résultat des imports. Il y a aussi des données dans la même feuille sur un autre range qu'il ne faut pas toucher donc je ne peux pas supprimer de ligne après l'import. Idéalement, je veux une fonction comme la mienne mais qui n'importe que ce dont j'ai besoin et copie tout au bon endroit.

Quelqu'un aurait-il la solution?

merci d'avance 🙂
 
Trier par date Trier par votes
Bonsoir le fil, le forum

@Robin CA---T
Ton fichier est trop nettoyé.
Il faudrait laisser des données fictives pour qu'on puisse tester

NB: Ton fichier a été irradié ou créé sur un PC qui vient de Fukushima parce qu'il contient plusieurs ThisWorBook et autres étrangetés.
En tout ce n'est pas un fichier Excel classique 😉
 
Vote positif 0 Vote négatif
Non a priori, ça n'est pas trop nettoyé vu que les macros font le taff pour le moment. Le but est juste de copier les lignes tout à droite (après la séparation) vers l'onglet "FICHIER ECHANGE" l'import des données se fait, j'ai juste besoin de faire un filtre pour virer les lignes dont la colonne Y est vide (mais j'aimerai le faire automatiquement dans la macro avant d'importer justement)
 
Vote positif 0 Vote négatif
Bonjour à tous

En supposant avoir compris :
A tester:
Code: 
Sub Import_Donnees_Signalement()
   
    Dim j As Integer, Lignefin As Integer, h As Integer
    Application.ScreenUpdating = False
    Lignefin = 2
    Dim c As Range
    For j = ActiveWorkbook.Worksheets.Count To 8 Step -1
        Worksheets(j).Range("AB2:AB26").Copy
        Worksheets(7).Range("T" & Lignefin).Select
               
        For h = 2 To 26 Step 1
        If Worksheets(j).Range("Y" & h) <> "" Then
          Worksheets(7).Range("T" & Lignefin) = Worksheets(j).Range("AB" & h)
          Worksheets(7).Range("U" & Lignefin) = Worksheets(j).Range("AC" & h)
          Worksheets(7).Range("V" & Lignefin) = Worksheets(j).Range("AD" & h)
          Worksheets(7).Range("W" & Lignefin) = Worksheets(j).Range("AE" & h)
          Worksheets(7).Range("X" & Lignefin) = Worksheets(j).Range("AF" & h)
          Worksheets(7).Range("Y" & Lignefin) = Worksheets(j).Range("AG" & h)
          Worksheets(7).Range("Z" & Lignefin) = Worksheets(j).Range("AH" & h)
          Worksheets(7).Range("AA" & Lignefin) = Worksheets(j).Range("AI" & h)
          Worksheets(7).Range("AB" & Lignefin) = Worksheets(j).Range("AJ" & h)
          Worksheets(7).Range("AC" & Lignefin) = Worksheets(j).Range("AK" & h)
          Worksheets(7).Range("AD" & Lignefin) = Worksheets(j).Range("AL" & h)
          Worksheets(7).Range("AE" & Lignefin) = Worksheets(j).Range("AM" & h)
          Worksheets(7).Range("AF" & Lignefin) = Worksheets(j).Range("AN" & h)
          Worksheets(7).Range("AG" & Lignefin) = Worksheets(j).Range("AO" & h)
          Worksheets(7).Range("AH" & Lignefin) = Worksheets(j).Range("AP" & h)
        Lignefin = Lignefin + 1
        End If
        Next h
       
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
       
       
    Next j
   
       
End Sub
 
Vote positif 0 Vote négatif
Merci bien,

J'ai déjà testé ça ne fonctionne pas :-/ Hélas. Et c'est le range AG & h qui doit être remplie (pour l'import) pour ne pas apparaître vide dans l'onglet Fichier Echange (la colonne Y dans cet onglet).

VB: 
Sub Import_Donnees_Signalement()
   
    Dim j As Integer, Lignefin As Integer, h As Integer
    Application.ScreenUpdating = False
    Lignefin = 2
    Dim c As Range
    For j = ActiveWorkbook.Worksheets.Count To 8 Step -1
        Worksheets(j).Range("AB2:AB26").Copy
        Worksheets(7).Range("T" & Lignefin).Select
               
        For h = 2 To 26 Step 1
        If Worksheets(j).Range("AG" & h) <> "" Then
          Worksheets(7).Range("T" & Lignefin) = Worksheets(j).Range("AB" & h)
          Worksheets(7).Range("U" & Lignefin) = Worksheets(j).Range("AC" & h)
          Worksheets(7).Range("V" & Lignefin) = Worksheets(j).Range("AD" & h)
          Worksheets(7).Range("W" & Lignefin) = Worksheets(j).Range("AE" & h)
          Worksheets(7).Range("X" & Lignefin) = Worksheets(j).Range("AF" & h)
          Worksheets(7).Range("Y" & Lignefin) = Worksheets(j).Range("AG" & h)
          Worksheets(7).Range("Z" & Lignefin) = Worksheets(j).Range("AH" & h)
          Worksheets(7).Range("AA" & Lignefin) = Worksheets(j).Range("AI" & h)
          Worksheets(7).Range("AB" & Lignefin) = Worksheets(j).Range("AJ" & h)
          Worksheets(7).Range("AC" & Lignefin) = Worksheets(j).Range("AK" & h)
          Worksheets(7).Range("AD" & Lignefin) = Worksheets(j).Range("AL" & h)
          Worksheets(7).Range("AE" & Lignefin) = Worksheets(j).Range("AM" & h)
          Worksheets(7).Range("AF" & Lignefin) = Worksheets(j).Range("AN" & h)
          Worksheets(7).Range("AG" & Lignefin) = Worksheets(j).Range("AO" & h)
          Worksheets(7).Range("AH" & Lignefin) = Worksheets(j).Range("AP" & h)
        Lignefin = Lignefin + 1
        End If
        Next h
       
         Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
       
       
    Next j
   
       
End Sub
 
Vote positif 0 Vote négatif
Hello

j'ai pas bien compris quelles lignes tu souhaites supprimer (ou ne pas coller...)
en attendant. plutot qu'un for h=2 to 26...
tu peux raccourcir la macro avec
VB: 
Sub Import_Donnees_Signalement()
   
    Dim j As Integer, Lignefin As Integer, h As Integer
    Application.ScreenUpdating = False
   
    Dim c As Range
    For j = ActiveWorkbook.Worksheets.Count To 8 Step -1
        Lignefin = Sheets("FICHIERS ECHANGES").Range("T" & Rows.Count).End(xlUp).Row + 1 'première ligne NON vide de la feuille FICHIERS ECHANGES
        Worksheets(j).Range("AB2:AP26").Copy Destination:=Worksheets(7).Range("T" & Lignefin & ":AH" & Lignefin + 26) 'copie de la zone AB2:AP26 à la fin de la feuille
    Next j
   
End Sub
 
Vote positif 0 Vote négatif
Je souhaite copier toutes les lignes du range AB:AP des feuilles avec un numéro dont la colonne AG n'est pas vide (donc celles à droite de "Fichiers echanges") vers le range T:AH de la feuille "Fichiers echanges"

Edit: cette macro ne fonctionne pas, je n'importe pas des valeurs fixes mais des valeurs d'autres cellules (j'ai fixé les valeurs pour l'exemple). Par exemple la permière colonne à importer a pour valeurs =$X$N et pas une valeur fixe donc lors de l'import avec la "version courte" comment je peux faire pour prendre uniquement les valeurs et pas le contenu de la case?
 
Vote positif 0 Vote négatif
Ceci peut etre....
VB: 
Sub Import_Donnees_Signalement()
  
    Dim j As Integer, Lignefin As Integer, h As Integer
    Application.ScreenUpdating = False
  
    Dim c As Range
    For Each Ws In Worksheets 'pour chaque feuille du classeur
      
        If IsNumeric(Ws.Name) Then 's'il s'agit d'une feuille avec un nom numérique (3212 3214...)
            Lignefin = Sheets("FICHIERS ECHANGES").Range("T" & Rows.Count).End(xlUp).Row + 1 'dernière ligne de la feuille échanges
      
         With Ws
            .Range("AG1").AutoFilter 'on filtre la feuille numérique sur la colonne AG
            .Range("$AB$1:$AP$38").AutoFilter Field:=6, Criteria1:="<>", _
        Operator:=xlAnd, Criteria2:="<>0"
            .Range("AB2:AP26").SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets(7).Range("T" & Lignefin) 'on recopie le résultat du filtre
         .Range("AG1").AutoFilter 'on desactive le filtre sur la feuille numérique
        End With
        End If
    
    Next Ws
  
End Sub
 
Vote positif 0 Vote négatif
Je reprends l'édit au cas où mais je copie le contenu des celles comme ça ? je dois copier la valeur sinon je vais avoir des trucs genre 0 au lieu de la valeur de la cellule (par exemple AB2 a pour contenu =$H$8) du coup comment régler ce détail?

Edit: C'est bon ça fonctionne !!!! Merci bien 🙂
 
Vote positif 0 Vote négatif
Ah en fait non :-/ Je ne sais pas trop pourquoi mais il n'importe que le première feuille est-ce que c'est possible de rajouter quelque part un code "PastSpecial" et dire qu'il ne copie que la valeur et non la formule?

C''est assez étrange car la première feuille fonctionne bien mais pas les autres

j'ai vu un truc similaire :https://www.mrexcel.com/forum/excel...ypevisible-copy-only-values-not-formulas.html mais je ne sais pas l'adapter
 
Vote positif 0 Vote négatif
skollrc à dit:
mais il n'importe que le première feuille est-ce que c'est possible de rajouter quelque part un code "PastSpecial"
Cliquez pour agrandir...

?? quel rapport entre le fait de n'avoir qu'une feuille traitée et mettre un paste special?

apparemment, tu ne travailles pas sur le meme fichier que celui posté..
dans ce que je t'ai proposé.
1) TOUTES les feuilles avec un nom numérique sont traitées: dans le cas présent: 2 feuilles: 3212 et 3214
2) le code ne copie que des valeurs. je ne vois aucune formule
3) comme indiqué par Stapple au début. le fichier posté semble corrompu.. il y a 3 feuilles "Thisworkbook" au lieu de 1 seule pour un fichier "normal"

==> reposte ton fichier sur lequel tu travailles vraiment
 
Vote positif 0 Vote négatif
Je crois que j'ai compris le problème. S'il n'y a aucun champ rempli (si le critère AG est toujours vide) il ne fait donc aucune sélection, il n'y a rien à copier et c'est là que ça bug. Si j'enlève tout les feuilles où le champ AG est jours vide ça marche à peu près même si parfois il ne copie pas tout. (il copie les formules et non les valeurs des cases). J'ai laissé des fiches exemple pour voir comment la macro se comporte.

J'ai essayé de modifier comme ça et ça fonctionne pour les fiches où il n'y a pas de valeurs:

VB: 
Option Compare Text
Sub Import_Donnees_Signalement()
    Dim j As Integer, Lignefin As Integer, h As Integer
    Application.ScreenUpdating = False
    Dim c As Range
    For Each Ws In Worksheets 'pour chaque feuille du classeur
     
        If IsNumeric(Ws.Name) Then 's'il s'agit d'une feuille avec un nom numérique (3212 3214...)
            Lignefin = Sheets("FICHIERS ECHANGES").Range("T" & Rows.Count).End(xlUp).Row + 1 'dernière ligne de la feuille échanges
     
         With Ws
            .Range("AG1").AutoFilter 'on filtre la feuille numérique sur la colonne AG
            .Range("$AB$1:$AP$38").AutoFilter Field:=6, Criteria1:="<>", _
        Operator:=xlAnd, Criteria2:="<>0"
'Si le résultat du filtre est vide
                TotErr = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
                If TotErr = 1 Then
                    GoTo NextIteration
                Else
'on recopie le résultat du filtre
                    .Range("AB2:AP38").SpecialCells(xlCellTypeVisible).Copy
            'Destination:=Worksheets(7).Range("T" & Lignefin)
            'on recopie le résultat du filtre
            Worksheets("FICHIERS ECHANGES").Range("T" & Lignefin).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
           
         .Range("AG1").AutoFilter 'on desactive le filtre sur la feuille numérique
                End If
            End With
        End If
NextIteration:
        Next Ws
       
    End Sub


End Sub
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Bonsoir le fil, le forum

vgendron à dit:
3) comme indiqué par Stapple au début. le fichier posté semble corrompu.. il y a 3 feuilles "Thisworkbook" au lieu de 1 seule pour un fichier "normal"
==> reposte ton fichier sur lequel tu travailles vraiment
Cliquez pour agrandir...
Merci vgendron de m'avoir évité un détour chez le yeutiste pour acquérir une nouvelle paire de lunette 😉
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

T
  • Question Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
2 K
thivame
T
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
X
  • Question Question
XL 2021 Transformation de données sur une ligne en plusieurs lignes
Réponses
9
Affichages
180
xavieralvaro
X
G
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
514
GClaire
G
C
  • Résolu(e)
Microsoft 365 Amélioration Macro.
Réponses
7
Affichages
555
crazy
C
G
  • Question Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
531
GClaire
G
PORCHER
  • Question Question
Microsoft 365 L'indice n'appartient pas à la sélection
Réponses
8
Affichages
676
TooFatBoy
TooFatBoy
B
  • Question Question
Microsoft 365 Additionner des cellules même ligne en userform vba
Réponses
13
Affichages
710
sousou
sousou
G
  • Résolu(e)
XL 2021 VBA dates au mauvais format
Réponses
5
Affichages
335
vgendron
vgendron
D
  • Question Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
2 K
Dranreb
Dranreb
L
  • Question Question
VBA : erreur sur boucle
Réponses
2
Affichages
308
Latias
L
D
  • Question Question
XL 2019 Aide à la compréhension d'un code VBA
Réponses
4
Affichages
1 K
Dudu2
Dudu2
C
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
91
CDALE
C
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
365
Gestionnaire_rh
G
C
  • Résolu(e)
XL 2016 Répartir dans des Groupes d'Effectifs Aléatoires ... mais pas trop
Réponses
2
Affichages
380
crocrocro
C
C
  • Question Question
Microsoft 365 MFC colonnes + description +date du jour
Réponses
5
Affichages
341
fanfan38
fanfan38
B
  • Question Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
615
Compte Supprimé 979
C
C
  • Question Question
XL 2019 Tableau- creation de lignes: probleme de hauteur de lignes
Réponses
6
Affichages
629
Cheyenne_2021
C
piga25
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
93
piga25
piga25
J
  • Question Question
Autres Supprimer une ligne dans une feuille à partir d'une valeur rentrée dasn une cellule d'une autre feuille
2
Réponses
25
Affichages
2 K
jmc78
J
Retour