XL 2013 Problème de copie de cellule quand valeur X est détectée

sempaimayfire

XLDnaute Nouveau
Bonjour, tout d'abord, bonne année et meilleurs vœux à tous et toutes !

Je fais appel à votre aide car cela fait 2 jours que je m'arrache les cheveux pour trouver une solution et je n'y arrive pas.

Je m'explique : Dans la feuille "FEUILLE D'IMPORT", j'extrais le format HTML d'une page intranet de ma boite.
Sur cette page, je vais chercher le terme "Composant" ainsi que le terme "Cas d'emploi" (qui se trouve plus bas dans la page).
Je sais que mon terme "Composant" se trouve dans une cellule fusionnée, mais (normalement) devrais avoir sa position en colonne G. (De même pour les valeurs que je veux extraire)
De plus, je sais que mon terme "Cas d'emploi" va apparaître plus bas dans la feuille, lui aussi dans une cellule fusionnée, mais devrait avoir sa position en A (j'espère que je vous ai pas perdu)

J'aimerai pouvoir extraire toutes les cellule sous le terme "Composant" jusqu'à arriver à "Cas d'emploi", si en plus je peux chopper la colonne M sur les même lignes que les valeurs que j'extrait ca serait top.

Pour l'instant voici le code que j'ai réalisé :

VB:
Sub import()

Sheets("FEUILLE D'IMPORT").Cells.Clear

    Application.CutCopyMode = False
    With Sheets("FEUILLE D'IMPORT").QueryTables.Add(Connection:= _
        "URL;http://intranet/TSA/technique/Donnees/Article/VisuArticle.asp?Machine=MA-0075" _
        , Destination:=Sheets("FEUILLE D'IMPORT").Range("$A$1"))
        .Name = "VisuArticle.asp?Machine=MA-0075"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    
    compteur = 0
    
     For Ligne = 1 To 1000
        
        If (Sheets("FEUILLE D'IMPORT").Cells(Ligne, 7) = "Composant") Then
        compteur = compteur + 1
            Sheets("Test").Cells(compteur, 1) = Sheets("FEUILLE D'IMPORT").Cells(Ligne, 7)
            If (Sheets("FEUILLE D'IMPORT").Cells(1, 1)) = ("Cas d'Emploi") Then Exit For
        
        End If
        
    Next

End Sub

Je me suis grandement inspiré d'un tuto que j'ai trouvé sur le site Excel-Pratique, code réalisé par Sébastien Mathier.
Sachez que je suis tout juste débutant en VBA, donc j'essaye de comprendre un peu comment ça marche :)

Merci d'avance pour ceux qui prendront le temps d'y jeter un oeil :)
 

GALOUGALOU

XLDnaute Accro

re sempaimayfire​

re sempaimayfire bonsoir le forum
en espérant avoir compris votre demande
j'ai modifié le code pour qu'il soit le plus compréhensible possible (ligne_depart, ligne_arrive).

en vba il est souhaitable de déclarer les variables (dans votre code compteur et ligne non déclaré)
-------------------------------------------------------------------------------
dans cette ligne de code attention aux parenthèses inutiles
Code:
  Sub TEST()
  Dim ligne_depart As Integer, ligne_arrive As Integer

    '---------------------------------------------
    Sheets("FEUILLE D'IMPORT").Cells.Clear
     Sheets("Test").Cells.ClearContents
     '------------------------------------------------------------
    ' votre code pour l'import html
    '--------------------------------------------------
    ligne_arrive = 3 'a parir de la 3eme ligne mais d'autre choix sont possibles
     For ligne_depart = 1 To 1000
   
        If Sheets("FEUILLE D'IMPORT").Cells(ligne_depart, 1) = "Cas d'Emploi" Then Exit For
        If Sheets("FEUILLE D'IMPORT").Cells(ligne_depart, 7) = "Composant" Then
        Sheets("Test").Cells(ligne_arrive, 1) = Sheets("FEUILLE D'IMPORT").Cells(ligne_depart, 7) ' 7 pour la colonne G
        Sheets("Test").Cells(ligne_arrive, 2) = Sheets("FEUILLE D'IMPORT").Cells(ligne_depart, 13) ' 13 pour la colonne M
        ligne_arrive = ligne_arrive + 1
        End If
    Next ligne_depart

End Sub
cdt
galougalou
 
Dernière édition:

Discussions similaires

Réponses
11
Affichages
306