Sub mizankaydet()
Dim x, q, w, y, k As Integer
Dim dosya
With ActiveSheet
        .Range("B11", .Range("B120:s120")).Select
        .Range("B11", .Range("B120:s120")) = ""
        .Range("b11").Select
End With
 
 
x = 1
Do While Worksheets("dosyaadlari").Cells(x, 1) <> ""
dosya = Worksheets("dosyaadlari").Cells(x, 1)
 
With Sheets("MİZAN")
 
y = 11
 
Do While Worksheets(dosya).Cells(y, 2) <> ""
 
If .Range("b10").End(xlDown).Row = 65536 Then
q = 11
Else
q = .Range("b10").End(xlDown).Row + 1
End If
 
k = 2
For w = 2 To 19
    .Cells(q, w) = Worksheets(dosya).Cells(y, k)
k = k + 1
Next
 
    .Cells(q, 5) = Split(dosya, ".")(0)  'ekledim.......
    .Cells(q, 6) = Split(dosya, ".")(1) 'ekledim.......
    .Cells(q, 7) = Split(dosya, ".")(2) 'ekledim.......
    .Cells(q, 8) = Split(dosya, ".")(3) 'ekledim.......
 
q = q + 1
y = y + 1
Loop ' dosya
 
End With
 
 
 
x = x + 1
Loop 'dosyaadlari
 
End Sub