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

  • Initiateur de la discussion GuestRC
  • Date de début
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 :)
 

Staple1600

XLDnaute Barbatruc
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 ;)
 
G

GuestRC

Guest
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)
 

pierrejean

XLDnaute Barbatruc
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
 
G

GuestRC

Guest
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
 

vgendron

XLDnaute Barbatruc
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
 
G

GuestRC

Guest
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?
 

vgendron

XLDnaute Barbatruc
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
 
G

GuestRC

Guest
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 :)
 
G

GuestRC

Guest
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
 

vgendron

XLDnaute Barbatruc
mais il n'importe que le première feuille est-ce que c'est possible de rajouter quelque part un code "PastSpecial"

?? 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
 
G

GuestRC

Guest
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:

Discussions similaires

Réponses
14
Affichages
618

Statistiques des forums

Discussions
311 720
Messages
2 081 892
Membres
101 831
dernier inscrit
gillec