Kod un çalıştırılması

[polis-53]

merhaba Arkadaşlar siteden aldığım aşağıdaki kodu excel 2007 de çalıştıramıyorum yardım edermisiniz.

kod:
Private Sub CommandButton1_Click()
On Error Resume Next
Call Liste(ThisWorkbook.Path, "")
MsgBox "işlem tamam"
End Sub
Private Sub Liste(Klasor As String, Uzanti As String)
Dim Hedef As Object, Kaynak As Object, dosya As String, sat As Long
Set Hedef = CreateObject("Scripting.FileSystemObject").getfolder(Klasor).SubFolders
Dim wb As Workbook
dosya = Dir(Klasor & "\*.**" & Uzanti)
While dosya <> ""
DoEvents
If ThisWorkbook.Name <> dosya Then

Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column + 1).Value = dosya

sayfaadi = "Sayfa11"
son = Application.ExecuteExcel4Macro("COUNTA('" & Klasor & "\[" & dosya & "]" & sayfaadi & "'!c1)")
deg = "'" & Klasor & "\[" & dosya & "]" & sayfaadi & "'!R"

For s = 2 To son + 1
aranan = ExecuteExcel4Macro(deg & s & "C" & 1)
For j = 2 To Cells(Rows.Count, "a").End(3).Row

If j <> 16 Then
If j <> 21 Then
If j <> 35 Then
If j <> 45 Then
bulunan = Cells(j, 1).Value
If aranan = bulunan Then
For i = 2 To 19
If i <> 9 Then
If i <> 13 Then
If IsNumeric(ExecuteExcel4Macro(deg & s & "C" & i)) = True Then
Cells(j, i).Value = Cells(j, i).Value + ExecuteExcel4Macro(deg & s & "C" & i)
End If
End If
End If
Next i
End If
End If
End If
End If
End If
Next j
Next s
End If

dosya = Dir
Wend
On Error GoTo sonraki
For Each Kaynak In Hedef
Call Liste(Kaynak.Path, "")
sonraki:
Next
Set Hedef = Nothing
End Sub

 

[Emir Hüseyin Çoban]

Merhaba,
Kodlarınızdaki aşağıdaki satırı incleyiniz.
getfold er arada boşluk olduğu için hata veriyor.

Set Hedef = CreateObject("Scripting.FileSystemObject").[COLOR="Red"]getfold er[/COLOR](Klasor).SubFolders

 

[polis-53]

merhaba arkadaşlar kodu tekrar gönderiyorum kod excel 2007 de uzantısı xls olan dosyaları hesaaplamıyor xlsx olduğu zaman kod çalışıyor bunun çözümünü bulamadım yardımlarınızı bekliyorum 1 nolu mesajımdaki kodda belirttiğiniz hata yok siteya aktarırken anlamadığım bir nedenle bir boşluk birakiyor orjinalinde bitişiktir.
kod:

Dim Klasor As Object
Dim Kaynak As String
Private Sub CommandButton1_Click()
On Error Resume Next
Call Liste(ThisWorkbook.Path, "")
MsgBox "işlem tamam"
End Sub
Private Sub Liste(Klasor As String, Uzanti As String)
Dim Hedef As Object, Kaynak As Object, dosya As String, sat As Long
Set Hedef = CreateObject("Scripting.FileSystemObject").getfolder(Klasor).SubFolders
Dim wb As Workbook
dosya = Dir(Klasor & "\*.**" & Uzanti)
While dosya <> ""
DoEvents
If ThisWorkbook.Name <> dosya Then

Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column + 1).Value = dosya

sayfaadi = "Sayfa11"
son = Application.ExecuteExcel4Macro("COUNTA('" & Klasor & "\[" & dosya & "]" & sayfaadi & "'!c1)")
deg = "'" & Klasor & "\[" & dosya & "]" & sayfaadi & "'!R"

For s = 2 To son + 1
aranan = ExecuteExcel4Macro(deg & s & "C" & 1)
For j = 2 To Cells(Rows.Count, "a").End(3).Row

If j <> 16 Then
If j <> 21 Then
If j <> 35 Then
If j <> 45 Then
bulunan = Cells(j, 1).Value
If aranan = bulunan Then
For i = 2 To 19
If i <> 9 Then
If i <> 13 Then
If IsNumeric(ExecuteExcel4Macro(deg & s & "C" & i)) = True Then
Cells(j, i).Value = Cells(j, i).Value + ExecuteExcel4Macro(deg & s & "C" & i)
End If
End If
End If
Next i
End If
End If
End If
End If
End If
Next j
Next s
End If

dosya = Dir
Wend
On Error GoTo sonraki
For Each Kaynak In Hedef
Call Liste(Kaynak.Path, "")
sonraki:
Next
Set Hedef = Nothing
End Sub

 

[polis-53]

kusura bakmayın arkadaşlar bu kod halit3 ten almıştım ve 1. mesajda yazdığım hatayı halit3 zaten cevabını vermişti ben atlamışım sorunum çozuldu tekrar özür dilerim kalın sağlıcakla