Pb:Nommer une cellule variable dans une macro

[Cobalt]

Bonjour à tous,
Je vous contacte, car j'ai besoin de votre aide pour corriger une macro créée à partir de son enregistrement sous Excel (pas optimisée en fait, moche, mais fonctionnelle)…
Elle est fait pour demander de copier la cellule (variable) d'une première feuille, aller sur un site internet et coller dans l'URL, la valeur de la cellule copier et mettre le tableau souhaité dans une seconde feuille, une fois cette étape passée copier une cellule dans cette nouvelle feuille et la coller dans une troisième puis revenir sur la seconde feuille et effacer le contenu de celle-ci sans effacer la requête afin de recommencer avec une boucle, car il y a plusieurs cellules de la première feuille à copier tant que la cellule suivante de la colonne n'est pas vide… je crois que c'est clair comme cela non…
Je pense que l'erreur vient du fait que j'appelle mal la cellule " Sheets("feuille1").Cells(2, J)" car je ne sais pas comment faire pour désigner la cellule Bj de la feuille1 (avec j variable)
Mais pour plus de clarté, voilà ma macro

------------------------

Sub Yahoo()
'
' Code_Classification_Yahoo Macro
'
Dim J As Integer
J = 18
If Sheets("feuille1").Cells(2, J) <> "" Then

Sheets("feuille2").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://fr.finance.yahoo.com/q/ls?s=" & Sheets("feuille1").Cells(2, J), Destination:=Range( _
"$B$3")) ' en fait ici je voudrait aussi faire varier le copiage vers le bas
.Name = "ls?s=" & Sheets("feuille1").Cells(2, J)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.saveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """yfncsubtit"",15"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False

End With

Sheets("feuille2").Select
Range("C5").Select
Selection.Copy
Sheets("feuille3").Select
Range("$K$36").Select
ActiveSheet.Paste
Sheets("feuille2").Select
Range("B3:C9").Select
Application.CutCopyMode = False
Selection.QueryTable.Delete
Selection.ClearContents

J = J + 1

End If

End Sub

------------------
Merci d'avance pour votre aide

E.C

 

[Compte Supprimé 979]

Re : Pb:Nommer une cellule variable dans une macro

Salut Cobalt,

En fait ton problème vien du fait que tu n'as pas regardé dans l'aide d'Excel,
comment utiliser la propriété Cells()

C'est : Cells(Index de ligne, Index de colonne)

Donc dans ton test il faut faire l'inverse de ce que tu as mis

If Sheets("feuille1").Cells([B][COLOR=blue]J, 2[/COLOR][/B]) <> "" Then

Sinon tu peux également utiliser :

If Sheets("feuille1").Range([B][COLOR=blue]"B" & J[/COLOR][/B]) <> "" Then

Voilà 😉

A+

 

[Cobalt]

Re : Pb:Nommer une cellule variable dans une macro

bonsoir BrunoM45,

tu as raison 🙂 ... je me plante toujours avec l'indication des colonnes et des lignes...

j'ai mis donc:
----------
Sub Yahoo()
' Code_Classification_Yahoo Macro
Dim J As Integer
J = 18
If Sheets("feuille1").Cells(J, 2) <> "" Then
With Sheets("feuille2")
.Select
With .QueryTables.Add(Connection:= _
"URL;http://fr.finance.yahoo.com/q/ls?s=" & Sheets("feuille1").Cells(J, 2), Destination:=Range( _
"$B$3"))
.Name = "ls?s=" & Sheets("feuille1").Cells(J, 2)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """yfncsubtit"",15"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
.Range("C5").Copy Destination:=Sheets("feuille3").Range("K36")
End With
With .Range("B3:C9")
.ClearContents
.QueryTable.Delete
End With
J = J + 1
End If
End Sub
--------------
Cependant, alors que j'ai essayé de faire varier le "K36" sur la seconde partie cad Range("C5").Copy Destination:=Sheets("feuille3").Range("K36") remplacé par Range("C5").Copy Destination:=Sheets("feuille3").cells(11,i)

Avec i nouvelle variable qui commence a 36 et un second compteur i=i+1 et bien j'ai un problème d'affichage, car dans la feuille 3 en K36 j'ai une cellule vide, en K37 idem, K38 idem, K39 j'ai une valeur affichée et k40 cellule vide et k41 affichage de la valeur…

J'ai pensé qu'en fait la partie clearcontent effaçait avant que la macro puisse copier ce qui fait que de temps en temps la macro copie une cellule vide… c'est pourquoi j'ai tenté d'introduire la ligne de commande [Range("C5").Copy Destination:=Sheets("feuille3").cells(11,i)] a la fin de la première partie avant de mettre fin a la boucle endwith cependant cela n'a rien changé et si ce n'est qu'il copie juste la première valeur en k36 et les autres cellules il les laisse vide…

J'ai repris la condition if mais c'est pareille… je sèche…

Tu en connais la raison de cet affichage????

Sinon comment trouves-tu la première partie (celle de la requête)? Est-elle optimale ou peut-elle être améliorée ?

Merci pour ton aide…et celle future de tous ceux qui vont m'aider
E.C

 

[Mytå]

Re : Pb:Nommer une cellule variable dans une macro

Salut le forum

Une solution déjà fourni sur un autre forum

Option Explicit 

Sub Req_Yahoo() 
Dim J As Byte 
Dim Ligne As Byte 
Dim Source As Worksheet 
Dim Requete As Worksheet 
Dim Repertoire As String 
Dim RangeObj As Object 

Repertoire = ThisWorkbook.Path 

Set Source = Sheets("Feuille1") 
Set Requete = Sheets("Feuille2") 

Application.ScreenUpdating = False 

Range("K5:M" & Range("B65536").End(3).Row).ClearContents 

For J = 5 To Range("C65536").End(3).Row 

If Source.Cells(J, 3) <> "" Then 

'Creer Fichier Pour La Requete 
If Dir(Repertoire & "\hr_6.iqy") = "hr_6.iqy" Then Kill (Repertoire & "\hr_6.iqy") 

Open Repertoire & "\hr_6.iqy" For Append As #1 

Print #1, "WEB" 
Print #1, "1" 
Print #1, "http://fr.finance.yahoo.com/q/pr?s=" & Sheets("Feuille1").Cells(J, 3) 
Print #1, "" 
Print #1, "Selection = EntirePage" 
Print #1, "Formatting = None" 
Print #1, "PreFormattedTextToColumns = True" 
Print #1, "ConsecutiveDelimitersAsOne = True" 
Print #1, "SingleBlockTextImport = False" 
Print #1, "DisableDateRecognition = False" 
Close #1 

With Requete 
    .Activate 
    With ActiveSheet.QueryTables.Add(Connection:= _ 
        "FINDER;C:\Yahoo\hr_6.iqy", Destination _ 
        :=Requete.Range("A1")) 
        .Name = Source.Cells(J, 3) 
        .FieldNames = False 
        .RowNumbers = False 
        .FillAdjacentFormulas = False 
        .PreserveFormatting = True 
        .RefreshOnFileOpen = False 
        .BackgroundQuery = True 
        .RefreshStyle = xlInsertDeleteCells 
        .SavePassword = False 
        .SaveData = False 
        .AdjustColumnWidth = True 
        .RefreshPeriod = 0 
        .WebSelectionType = xlEntirePage 
        .WebFormatting = xlWebFormattingNone 
        .WebPreFormattedTextToColumns = True 
        .WebConsecutiveDelimitersAsOne = True 
        .WebSingleBlockTextImport = False 
        .WebDisableDateRecognition = False 
        .Refresh BackgroundQuery:=False 
    End With 
'Copy data de la requête 

    Set RangeObj = Cells.Find(What:="ISIN:", After:=ActiveCell, _ 
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _ 
    SearchDirection:=xlNext, MatchCase:=False) 
    
    If Not RangeObj Is Nothing Then 
      Ligne = RangeObj.Row 
        .Range("B" & Ligne).Copy Source.Range("K" & J) 
        .Range("B" & Ligne + 1).Copy Source.Range("L" & J) 
        .Range("B" & Ligne + 2).Copy Source.Range("M" & J) 
        Source.Range("K" & J & ":M" & J).VerticalAlignment = xlCenter 
            With .Cells 
              .Delete 
            End With 
    Else 
      Source.Range("K" & J) = "Erreur, Référence Non Trouvée..." 
          With .Cells 
            .Delete 
          End With 
    End If 
    
End With 
    
End If 

Next J 

Source.Activate 
Application.ScreenUpdating = True 

End Sub

Mytå