Makro kodu hakkında yardım

[gokhan83]

Herkese merhaba;
Uzun süredir çalıştığım bir dosyam var. Data isimli klasörde yaklaşık 1000 kadar müşterinin hesap bilgileri var ve bu sayı her geçen gün artıyor.Hesap bilgilerinin üst sayfasında müşteriye ait bilgiler bulunuyor. Bu bilgilerde çok sık değişiklikler oluyor. Yapmak istediğim makro ile bir üst klasörde bulunan müşteri bilgilerinin istediğim zaman tek tuşla tüm müşteri bilgilerini güncellesin. Bunu daha önce düşeyara fonksiyonu ile yapıyordum dosyanın açılması zaman aldığı için böyle bir yöntem düşündüm. Bu siteden öğrendiğim kadarıyla ekteki kodu yazdım ancak çalıştıramadım. Ayrıca klasörün bir örneğini de ekledim. Kodta hata yaptığım yerleri düzeltmem konusunda yardımcı olabilecek var mı? Veya farklı bir metot önerebilir misiniz?

Sub bilgi_guncelle()

ThisWorkbook.Sheets("Liste").Select
For i = 4 To Range("A4").End(4).Row
If Cells(i, "A").Value = "" Or Cells(i, "A").Value = "0" Then
MsgBox "İşlem Tamam", vbCritical
Exit Sub
End If
Dim k1 As Workbook, k2 As Workbook, k3 As Workbook, s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Set k1 = ThisWorkbook
Set k2 = Workbooks.Open(ThisWorkbook.Path & "\Data\" & Cells(i, "A").Value)
Set k3 = Workbooks.Open(ThisWorkbook.Path & "\müşteri bilgileri.xlsm")
Set s1 = k1.Sheets("Aktar")
Set s2 = k2.Sheets("2016")
Set s3 = k3.Sheets("Data")
Application.DisplayAlerts = True
s2.Range("f1").Select
s2.Cells("F1").Value = s3.Cells(i, "A")
s2.Cells("F2").Value = s3.Cells(i, "B")
s2.Cells("F3").Value = s3.Cells(i, "C")
s2.Cells("F4").Value = s3.Cells(i, "D")
s2.Cells("F5").Value = s3.Cells(i, "E")
s2.Cells("F6").Value = s3.Cells(i, "F")
s2.Cells("J1").Value = s3.Cells(i, "G")
s2.Cells("J2").Value = s3.Cells(i, "H")
s2.Cells("J3").Value = s3.Cells(i, "I")
s2.Cells("J4").Value = s3.Cells(i, "J")
s2.Cells("J5").Value = s3.Cells(i, "K")
s2.Cells("J6").Value = s3.Cells(i, "L")
s2.Cells("M1").Value = s3.Cells(i, "M")
s2.Cells("M2").Value = s3.Cells(i, "P")
s2.Cells("M3").Value = s3.Cells(i, "Q")
s2.Cells("M4").Value = s3.Cells(i, "R")
s2.Cells("M6").Value = s3.Cells(i, "S")

s2.Protect Password:="falcon2009"
k2.Save
k2.Close
Next i
k3.Close
End Sub

 

[PLİNT]

Merhaba
Burayada;http://s3.dosya.tc/ örnek dosyanızı ekleyip indirme adresini verirmisiniz?

 

[gokhan83]

Sayın Plint dosyayı yükledim.
http://s3.dosya.tc/server7/jdnkzo/Yeni_klasor.rar.html

 

[PLİNT]

Merhaba
Aşağıdaki şekilde denermisiniz?
Yukarıdaki kodlarınızdaki "Cells" yerine "Range" olmalı
s2.Cells("F3").Value s2.Range("F3").Value

Örneğinizdeki "Data" klasörü içerisinde ki dosya "xlsm" idi şu bölümü ayarlayın çeşitli formattaysa silin.

Workbooks.Open(ThisWorkbook.Path & "\Data\" & Cells(i, "A").Value[COLOR="Red"] & ".xlsm"[/COLOR])

 Sub bilgi_guncelle()

ThisWorkbook.Sheets("Liste").Select 'BU SAYFA ÖRNEK DOSYADA ADI"Sayfa1"
For i = 4 To Range("A4").End(4).Row
If Cells(i, "A").Value = "" Or Cells(i, "A").Value = "0" Then
MsgBox "İşlem Tamam", vbCritical
Exit Sub
End If
Dim k1 As Workbook, k2 As Workbook, k3 As Workbook, s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Set k1 = ThisWorkbook
Set k2 = Workbooks.Open(ThisWorkbook.Path & "\Data\" & _
 Cells(i, "A").Value [COLOR="Red"]& ".xlsm"[/COLOR])

Set k3 = Workbooks.Open(ThisWorkbook.Path & "\müşteri bilgileri.xlsm")
'Set s1 = k1.Sheets("Aktar")
Set s2 = k2.Sheets("2016")
Set s3 = k3.Sheets("Data")
Application.DisplayAlerts = True
[COLOR="Red"]k2.Activate[/COLOR]
[COLOR="Red"]s2.Unprotect Password:="falcon2009"[/COLOR]
s2.Range("f1").Select

s2.[COLOR="Red"]Range[/COLOR]("F1").Value = s3.Cells(i, "A")
s2.[COLOR="Red"]Range[/COLOR]("F2").Value = s3.Cells(i, "B")
s2.Range("F3").Value = s3.Cells(i, "C")
s2.Range("F4").Value = s3.Cells(i, "D")
s2.Range("F5").Value = s3.Cells(i, "E")
s2.Range("F6").Value = s3.Cells(i, "F")
s2.Range("J1").Value = s3.Cells(i, "G")
s2.Range("J2").Value = s3.Cells(i, "H")
s2.Range("J3").Value = s3.Cells(i, "I")
s2.Range("J4").Value = s3.Cells(i, "J")
s2.Range("J5").Value = s3.Cells(i, "K")
s2.Range("J6").Value = s3.Cells(i, "L")
s2.Range("M1").Value = s3.Cells(i, "M")
s2.Range("M2").Value = s3.Cells(i, "P")
s2.Range("M3").Value = s3.Cells(i, "Q")
s2.Range("M4").Value = s3.Cells(i, "R")
s2.Range("M6").Value = s3.Cells(i, "S")
s2.Protect Password:="falcon2009"
k2.Save
k2.Close
Next i
k3.Close
End Sub

 

[gokhan83]

Sayın Plint ilginiz ve emeğiniz için teşekkür ederim. Sorun çözüldü.