kısaltma, tasnif , eksik vs

[burhanyildirim11]

arkadaşlar kolay gelsin .

sizlere sorarak, bir çok arkadaş yardımcı oldu saolsunlar , ekle sil tarzı ilk amatör kodumu yazdım .

C:\Users\eli\Desktop\burhan\ klasöründeki , DEĞİŞKEN SAYIDAKİ xls dosylarının isimlerini dosyasay makrosu ile a1 sutununa yazdırıp ,
vericek makrosu ile bunlarıda her dosyayı sheetlere yazdırıyorum .

verileri çektiğim dosyların 1 de olsa 100 de olsa hepsi aynı dosya uzantısına sahip , hepsinde birer sheet var.


genel anlamda sorun yok gibi ama siz üstatların gözü ile gereksiz yazdığım ilgisiz alakasız fazlalıklar vs kısımlar filan varsa düzeltebilirseniz sevinirim..

Sub dosyasay()

Sheets("Sayfa1").Cells.Clear

    Dim Yol, Dosya As String
    Dim w1 As Workbook
    Dim s1 As Worksheet
    Dim i As Integer

  Set w1 = ThisWorkbook
  Set s1 = w1.Worksheets("Sayfa1")

    i = 1
    Yol = "C:\Users\eli\Desktop\burhan\"
 
    Dosya = Dir(Yol & "*.xls*")
 
    While Dosya <> ""
       
                If Dosya <> "burhan_.xlsm" Then
     s1.Cells(i, 1).Value = Yol & Dosya
   
                i = i + 1
     End If
                Dosya = Dir
     Wend
     vericek
   
    End Sub
Private Sub vericek()
Dim wb As Workbook
Dim sh As Worksheet
Dim w2 As Workbook
Dim s2 As Worksheet
Dim Dosya As Variant
Set w1 = ThisWorkbook
Set s1 = w1.Worksheets("Sayfa1")
Dim sonsat As Integer
sonsat = s1.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To sonsat

With Application.FileDialog(msoFileDialogOpen)
  .InitialFileName = "C:\Users\eli\Desktop\burhan\"

    Dosya = w1.Worksheets("Sayfa1").Cells(i, 1)
   
End With

Application.ScreenUpdating = False
Set w2 = Workbooks.Open(Dosya)
Set s2 = w2.Worksheets("Sheet1")

s2.Copy s1


w2.Close
Next i
Application.ScreenUpdating = True

s1.Activate


End Sub