chercher valeur cellule dans autre répertoire

Question

Bonjour,
je veux créer une appli VBA et j'aimerais savoir pkoi mon code bloque, je voudrais aller chercher une valeur
dans la base de donnée du classeur ProjetVBAHITRATIO.xls en fonction de leur date, pour la copier dans le classeur ProjetVBABOUGEOIS.xls.

voici mon code : 

Sub macrook()

Dim i As Integer

report = "C:\Documents and Settings\Seb\Mes documents\Cours\ProjetVBABOUGEOIS.xls"

base = "C:\Documents and Settings\SebMes documents\Cours\ProjetVBAHITRATIO.xls"

For i = 1 To 7

If Workbooks(base).ActiveSheet("Feuil1").Cells(i, 2) >= DateValue("12/01/2004") And Workbooks(base).ActiveSheet("Feuil1").Cells(i, 2) <= DateValue("12/02/2004") Then
Workbooks(report).Sheets("Feuil1").Cells(i, 2) = Workbooks(base).Sheets("Feuil1").Cells(i, 2)

End If

Next

End Sub

Pouvez vous m'aider ?

lermite222 · Answer

Bonjour,
Essaye avec...
Sub macrook()
Dim i As Integer
Dim Report As Workbooks
Dim Base As Workbooks
    'Supposant que cette macro est dans le classeur Base
    Set Report = "C:\Documents and Settings\Seb\Mes documents\Cours\ProjetVBABOUGEOIS.xls"
    Report.Open                       'Manquerait pas un Slach là ?
    Set Base = "C:\Documents and Settings\SebMes documents\Cours\ProjetVBAHITRATIO.xls"
    'Je ne peu rien dire sur les conditions faute de renseignement
    For i = 1 To 7
        If Workbooks(Base).ActiveSheet("Feuil1").Cells(i, 2) >= DateValue("12/01/2004") And Workbooks(Base).ActiveSheet("Feuil1").Cells(i, 2) <= DateValue("12/02/2004") Then
            Workbooks(Report).Sheets("Feuil1").Cells(i, 2) = Workbooks(Base).Sheets("Feuil1").Cells(i, 2)
        End If
    Next
End Sub
A+

lermite222 · Answer

Sub MacroSuite()
'Plus simple
Dim i As Integer
Dim Report As Worksheet
Dim Base As Worksheet
    Workbooks("C:\Documents and Settings\Seb\Mes documents\Cours\ProjetVBABOUGEOIS.xls").Open
    Set Report = woorkbooks("ProjetVBABOUGEOIS.xls").Sheets("Feuil1")
    Set Base = Workbooks("ProjetVBAHITRATIO.xls").Sheets("Feuil1")
    For i = 1 To 7
        If Base.Cells(i, 2) >= DateValue("12/01/2004") And _
                Base.Cells(i, 2) <= DateValue("12/02/2004") Then
            Report.Cells(i, 2) = Base.Cells(i, 2)
        End If
    Next
End Sub
Je ne peu toujours pas tester vu qu'il me manque tes classeurs et les renseignement nécessaires.
Tu dis.
A+

herod1983 · Answer

Salut

Essai comme ça

Set Report = woorkbooks("ProjetVBABOUGEOIS.xls").Sheets("Feuil1")
    Set Base = Workbooks("ProjetVBAHITRATIO.xls").Sheets("Feuil1")

For i = 1 To 7
        If Base.Cells(i, 2).value >= "12/01/2004" then  
               if Base.Cells(i, 2).value <= "12/02/2004" Then
                     Report.Range("A1").value = Base.Cells(i, 2).value
               End If
        End if
Next

Pas besoin de t'encombrer avec un format date ce que tu cherche c'est seulement une correspondance, par contre ta boucle rend compte seulement pour la feuille base mais pas report donc pour voir si sa fonctionne déjà fait une copie dans un range comme ceux-ci.

herod1983 · Answer

désolé j'ai fais trop vite je suis dessus

je te tiens au courant

herod1983 · Answer

la c'est bon la macro de recherche fonctionne il y avait juste des .value a intégrer ta macro était bonne

par contre je ne peux pas voir pour la copie vers un autre classeur
en tous cas il te faudra je pense d'abord ouvrir le classeur report avant de copier des valeurs dedans, comme je t'es mis.

For i = 1 To 7
        If Cells(i, 2).Value > DateValue("11/01/2004") And _
               Cells(i, 2).Value < DateValue("13/02/2004") Then
          
          workbook(report).open      
          report.sheets(1).Cells(i, 2).Value = Cells(i, 2).Value
               
        End If
Next i

Seb · Answer

heu.....ça marche toujours pas j'ai encore essayé un autre code mais ça veut pas
c'est un truc de fou !!!!

herod1983 · Answer

pour le code de recherche si tu le fais que dans le classeur base sa fonctionne c'est la copie dans le classeur report qui déconne je cherche aussi lol

herod1983 · Answer

Voila la c'est bon change juste le chemin de report

  report = "f:\Textes\essai2.xls"


For i = 1 To 7
        If Cells(i, 2).Value > DateValue("11/01/2004") And _
               Cells(i, 2).Value < DateValue("13/02/2004") Then
                Application.DisplayAlerts = False
                Workbooks.Open report, 0, ReadOnly:=False
                ActiveWorkbook.Sheets(1).Cells(i, 2).Value = Cells(i, 2).Value
                Application.DisplayAlerts = True
        End If
Next i

End Sub

lermite222 · Answer

Re,
Si au moins tu disait l'erreur que tu à ? le texte et le N° ?
Quel est le nom du classeur DEJA ouvert et dans lequel tu met la macro ?
"Ca marche pas" ça ne nous dis pas grand chose.

lermite222 · Answer

Bon, j'ai créer des classeurs suivant tes explications, j'ai fait la macro et elle fonctionne (j'ai tester)
Sub MacroSuite()
'Plus simple
Dim i As Integer
Dim Report As Worksheet
Dim Base As Worksheet
Dim Nom1 As String, Nom2 As String
Dim Chemin As String
'de ProjetVBAHITRATIO.xls  >>> à >>>  ProjetVBABOUGEOIS.xls
'Base = ProjetVBAHITRATIO.xls et est le classeur ouvert
    Nom1 = "ProjetVBABOUGEOIS.xls"
    Chemin = Environ$("USERPROFILE") & "\mes documents\Cours\ProjetVBABOUGEOIS.xls"
    Workbooks.Open (Chemin)
    Set Report = Workbooks(Nom1).Sheets("Feuil1")
    Nom2 = ThisWorkbook.Name
    Set Base = Workbooks(Nom2).Sheets("Feuil1")
    For i = 1 To 7
        If Base.Cells(i, 2) >= DateValue("12/01/2004") And _
                Base.Cells(i, 2) <= DateValue("12/02/2004") Then
            Report.Cells(i, 2) = Base.Cells(i, 2)
        End If
    Next
End Sub
J'ai décomposé les noms pour pouvoir suivre le déroulement de la macro, mais ce n'est pas nécessaire.
Pour test colle la macro tel quel.
Si ça coince quel que part, dis le N° de l'erreur et sont libellé.
A+
A+

Chercher valeur cellule dans autre répertoire

10 réponses

Discussions similaires

Newsletters