Bonjour tout le monde
je désire modifier une de mes macro , mais j'arrive pas à trouver comment faire pour importer tout simplement un champs à partir de la feuille source vers la feuille en cour j'ai marqué en commentaire dans le code quand je voulais importer ce champ.

j'ai essayé par variable intermédiaire et aussi de le faire directement sauf que je dois fermer le fichier source avant dans le traitement

merci d'avance

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub Test()
Dim Msg As String, Title As String, Cible As String
Dim Prs As Currency
Dim Wbk As Workbook
Dim L As Integer
Dim Lig As Long
Dim c As Range
Dim Fichier
 
Application.DisplayAlerts = False
Fichier = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
 
If Fichier <> False Then
    Set Wbk = Workbooks.Open(Fichier)
 
    Msg = "Veuillez saisir votre longueur"
    Title = "-------PRS--------"
    L = Val(InputBox(Msg, Title, Default))
 
    With Wbk.Worksheets(1)
 
'je désire importer la cellule (15,39) dans la worksheets("PRS data")
        If L <= 1000 * .Cells(23, 41).Value Then
            .Cells(23, 41).Value = L / 1000
            Prs = .Cells(25, 41).Value
        ElseIf L <= 1000 * .Cells(23, 42).Value Then
            .Cells(23, 42).Value = L / 1000
            Prs = .Cells(25, 42).Value
        ElseIf L >= 1000 * .Cells(23, 43).Value Then
            .Cells(23, 43).Value = L / 1000
            Prs = .Cells(25, 43).Value
        End If
        Cible = .Cells(4, 4).Value
    End With
    Wbk.Close True
    Set Wbk = Nothing
 Cible = C
    On Error Resume Next
        x = Application.Match(Cible,ThisWorkbook.Worksheets("PRS data").Colomns("A:A"),0)
        If x = 0 Then
            MsgBox "Valeur " & Cible & " non trouvée."
        Else           
            MsgBox "Valeur " & Cible & " trouvée dans la ligne: " & x
ThisWorkbook.Worsheets("PRS data").cells(x,6).value = PRS
'je désire afficher la cellule ici .cells(x,11).value
        End If
 End Sub