Iyi gunler elimde asagidaki gibi bir makro var ve gayet guzel çalisiyor.
Benim iki problemim var.
Birincisi, dosya yolunu maalesef sadece makronun içerisinde belirtilen : C:\Users\DATA\olarak kullanabiliyoruz.
Bu dosya yolunu her kullanisimizda farkli bir dosya yolu olarak manuel bir sekilde kendimizin seçmesi için nasil bir ekleme yapmamiz gerekli?
ikincisi ise makro *.xlsx formatli bir excel klasoru yoksa *.xls formatina geçis yapmadan direk duruyor yani: Fichier = Dir("*.xls") komutunda tek bir dosya türü için arama yapiyor.
Yardimlariniz için tesekkur ederim.
Benim iki problemim var.
Birincisi, dosya yolunu maalesef sadece makronun içerisinde belirtilen : C:\Users\DATA\olarak kullanabiliyoruz.
Bu dosya yolunu her kullanisimizda farkli bir dosya yolu olarak manuel bir sekilde kendimizin seçmesi için nasil bir ekleme yapmamiz gerekli?
ikincisi ise makro *.xlsx formatli bir excel klasoru yoksa *.xls formatina geçis yapmadan direk duruyor yani: Fichier = Dir("*.xls") komutunda tek bir dosya türü için arama yapiyor.
Yardimlariniz için tesekkur ederim.
Kod:
Sub import_auto()
Dim principal As ThisWorkbook
Dim repertoire As String, fichier As String
Application.ScreenUpdating = False
Set principal = ThisWorkbook
repertoire = "C:\Users\DATA\"
ChDir repertoire
fichier = Dir("*.xlsx; *.xlsm; *.xlsa; *.xls")
Do While fichier <> ""
If fichier <> principal.Name Then
Workbooks.Open fichier
On Error GoTo suivant
With Sheets(1)
On Error GoTo 0
On Error Resume Next
.Range("A1:A" & .[b65536].End(xlUp).Row) = Left(fichier, Len(fichier) - 4)
.UsedRange.EntireRow.Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
End With
ActiveWorkbook.Close False
End If
suivant:
If Err.Number = 9 Then MsgBox "Pas de feuille ""1"" dans le fichier " & fichier, vbExclamation: ActiveWorkbook.Close False
fichier = Dir
Loop
End Sub
Son düzenleme: