francischristy
XLDnaute Nouveau
Bonsoir tout le monde,
J'utilise un fichier Excel 2003 avec importation de données "With Application.FileSearch". Cette application ne marche pas pour Excel 2007 malheureusement et je n'arrive pas à l'adapter. Pouvez-vous m'aider ?
Merci
Christy
'*******************************************
Sub Auto_Right()
'chemin = "C:\Documents and Settings\Bureau\Test"
Application.ScreenUpdating = True
Sheets("Data").Select
Range("A2").Select
nomfichier = ActiveWorkbook.Name
With Application.FileSearch
'.LookIn = chemin
.LookIn = "C:\Documents and Settings\Bureau\Test\"
.SearchSubFolders = True
.Filename = "*_Right.xls"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
fichierlu = .FoundFiles(i)
If Right(fichierlu, 3) = "xls" Then
Workbooks.Open Filename:=fichierlu, ReadOnly:=True
fenêtrelue = ActiveWorkbook.Name
'On Error Resume Next
Worksheets("Feuil1").Activate
If ActiveSheet.Name <> "Feuil1" Then
ActiveWindow.Close SaveChanges:=False
Exit Sub
End If
Test_1 = Range("C6").Value
Test_2 = Range("F8").Value
Test_3 = Range("C8").Value
ActiveWindow.Close SaveChanges:=Fals
Application.ScreenUpdating = True
ActiveCell.Value = Test_1
ActiveCell.Offset(0, 1).Value = Test_2
ActiveCell.Offset(0, 2).Value = Test_3
ActiveCell.Offset(1, 0).Select
End If
Next i
Else
Exit Sub
End If
End With
End Sub
'******************************************************
J'utilise un fichier Excel 2003 avec importation de données "With Application.FileSearch". Cette application ne marche pas pour Excel 2007 malheureusement et je n'arrive pas à l'adapter. Pouvez-vous m'aider ?
Merci
Christy
'*******************************************
Sub Auto_Right()
'chemin = "C:\Documents and Settings\Bureau\Test"
Application.ScreenUpdating = True
Sheets("Data").Select
Range("A2").Select
nomfichier = ActiveWorkbook.Name
With Application.FileSearch
'.LookIn = chemin
.LookIn = "C:\Documents and Settings\Bureau\Test\"
.SearchSubFolders = True
.Filename = "*_Right.xls"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
fichierlu = .FoundFiles(i)
If Right(fichierlu, 3) = "xls" Then
Workbooks.Open Filename:=fichierlu, ReadOnly:=True
fenêtrelue = ActiveWorkbook.Name
'On Error Resume Next
Worksheets("Feuil1").Activate
If ActiveSheet.Name <> "Feuil1" Then
ActiveWindow.Close SaveChanges:=False
Exit Sub
End If
Test_1 = Range("C6").Value
Test_2 = Range("F8").Value
Test_3 = Range("C8").Value
ActiveWindow.Close SaveChanges:=Fals
Application.ScreenUpdating = True
ActiveCell.Value = Test_1
ActiveCell.Offset(0, 1).Value = Test_2
ActiveCell.Offset(0, 2).Value = Test_3
ActiveCell.Offset(1, 0).Select
End If
Next i
Else
Exit Sub
End If
End With
End Sub
'******************************************************
