bonjour a tous,
j'ai besoin aide sur une programmation je souhaite inscrire le chemin dans la feuille TARIFAIRE celulle A1
dans mon exemple ci dessous ma macro fonctionne correctement "chemin inscrit en dur"
d'avance merci de votre aide
Sub EXPORT()
Application.ScreenUpdating = False
R = MsgBox("Vous voulez importer les Relevés de Prix ? ", vbYesNo + vbQuestion, "EXTRACTION DES RELEVES")
If R = vbYes Then
With ActiveWorkbook
.Sheets("TARIFAIRE").Unprotect
End With
Dim W As String
i = 9
W = Dir("C:\Documents and Settings\FRNTO2M\Bureau\TEST\*.xls")
Do Until W = ""
i = i + 1
Workbooks.Open Filename:="C:\Documents and Settings\FRNTO2M\Bureau\TEST\" & W
If i = 110 Or i = 112 Then i = i + 2
Worksheets(1).Unprotect ("AZERTY")
'or boeuf
ActiveWorkbook.Sheets(1).Range("c3:c5").Select
Selection.Copy
Application.Windows("TONY.xls").Activate
Cells(5, i).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(5, i).Validation.Delete
Cells(6, i).Validation.Delete
Cells(7, i).Validation.Delete
Windows(2).Activate
Application.CutCopyMode = False
'le magasin
Range("d5:d6").Select
Selection.Copy
Application.Windows("TONY.xls").Activate
Cells(9, i).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(9, i).Validation.Delete
Cells(10, i).Validation.Delete
Windows(2).Activate
Application.CutCopyMode = False
Worksheets(1).Protect ("AZERTY")
Application.Windows(1).Activate
ActiveWorkbook.Close savechanges:=False
W = Dir
Loop
End If
Sheets("TARIFAIRE").Select
Application.ScreenUpdating = True
End Sub
j'ai besoin aide sur une programmation je souhaite inscrire le chemin dans la feuille TARIFAIRE celulle A1
dans mon exemple ci dessous ma macro fonctionne correctement "chemin inscrit en dur"
d'avance merci de votre aide
Sub EXPORT()
Application.ScreenUpdating = False
R = MsgBox("Vous voulez importer les Relevés de Prix ? ", vbYesNo + vbQuestion, "EXTRACTION DES RELEVES")
If R = vbYes Then
With ActiveWorkbook
.Sheets("TARIFAIRE").Unprotect
End With
Dim W As String
i = 9
W = Dir("C:\Documents and Settings\FRNTO2M\Bureau\TEST\*.xls")
Do Until W = ""
i = i + 1
Workbooks.Open Filename:="C:\Documents and Settings\FRNTO2M\Bureau\TEST\" & W
If i = 110 Or i = 112 Then i = i + 2
Worksheets(1).Unprotect ("AZERTY")
'or boeuf
ActiveWorkbook.Sheets(1).Range("c3:c5").Select
Selection.Copy
Application.Windows("TONY.xls").Activate
Cells(5, i).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(5, i).Validation.Delete
Cells(6, i).Validation.Delete
Cells(7, i).Validation.Delete
Windows(2).Activate
Application.CutCopyMode = False
'le magasin
Range("d5:d6").Select
Selection.Copy
Application.Windows("TONY.xls").Activate
Cells(9, i).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(9, i).Validation.Delete
Cells(10, i).Validation.Delete
Windows(2).Activate
Application.CutCopyMode = False
Worksheets(1).Protect ("AZERTY")
Application.Windows(1).Activate
ActiveWorkbook.Close savechanges:=False
W = Dir
Loop
End If
Sheets("TARIFAIRE").Select
Application.ScreenUpdating = True
End Sub