Verileri dosyalardan alınması hk.

[1903emre34@gmail.com]

Merhaba,

Veri alınacak dosyada yer alan sayfa2 "C4:C86 hücreleride yer alan bu sayfada ANA sayfanın altında H ve I sütündaki rakamları bu sayfada C ve D sütünların altında yerleşmesi için nasıl kod oluşturabiliriz?
http://s6.dosya.tc/server11/s9b8qm/dosya.zip.html

 

[PLİNT]

Merhaba
Örneğinize göre "veri alınacak dosya" "C" sütununda olupta; "anasayfa" da olmayan rakam yok ise;
aşağıdaki gibi olabilir:

 [SIZE="2"]Private Sub CommandButton1_Click()
On Error Resume Next
DOSYA = [COLOR="RoyalBlue"]ThisWorkbook.Path[/COLOR] & "\" & "[COLOR="Blue"]veri alınacak dosya[/COLOR]" & ".xlsx"
Set Aç = New Excel.Application
Aç.Workbooks.Open DOSYA
Set hz = Aç.Workbooks(Dir(DOSYA))
Set hzs = hz.Sheets("[COLOR="Blue"]Sayfa2[/COLOR]")
x = hzs.Cells(Rows.Count, "C").End(3).Row
If Err > 0 Then MsgBox "Bir hata oluştu": GoTo çık
For a = 1 To x
If IsNumeric(hzs.Cells(a, "C")) = True Then
Set r = [A:A].Find(hzs.Cells(a, "C").Text, LookIn:=xlValues, Lookat:=xlWhole)
If Not r Is Nothing Then Range("C" & r.Row & ":D" & r.Row).Value = hzs.Range("H" & a & ":I" & a).Value
End If
If Err > 0 Then MsgBox "Bir hata oluştu": GoTo çık
Next
çık:
hz.Close SaveChanges:=False
Aç.Quit
Set Aç = Nothing: Set hz = Nothing
End Sub[/SIZE]

 

[1903emre34@gmail.com]

Merhaba,

Üstad, kodları çalıştırdığım zaman veri alınacak dosyada yer alan sayfa2'deki veriler gelmedi

 

[PLİNT]

Merhaba,

Üstad, kodları çalıştırdığım zaman veri alınacak dosyada yer alan sayfa2'deki veriler gelmedi

Merhaba
Ek dosyadaki gibi deneyin
1.buton (yukarıdaki kodlar) "A" hücrelerinin; "C" ve "D" karşılıklarını değiştirecek;
2. buton alt boş satırlara gelmesini sağlayacaktır.
http://s6.dosya.tc/server11/sj9fv1/dosya.zip.html

 

[1903emre34@gmail.com]

Üstadım, teşekkürler

 

[1903emre34@gmail.com]

Merhaba,

Verileri (yeni) diğer dosyalardan alırken, eskisinin altında yer alıyor, ek dosyadaki gibi, onu önlemek adına kodlarda nasıl değişiklik yapabiliriz.

http://www.dosya.tc/server10/w32ebi/veriler.zip.html

 

[PLİNT]

Merhaba,

Verileri (yeni) diğer dosyalardan alırken, eskisinin altında yer alıyor, ek dosyadaki gibi, onu önlemek adına kodlarda nasıl değişiklik yapabiliriz.

Merhaba
Verilerin ekleneceği dosyadaki "A" sütunu kodları verilerin geleceği dosyadakilerle aynı ise;
"A2: D" aralığını temizleyen kodlar ekleyelim.

[SIZE="2"]Private Sub Command[COLOR="Blue"]Button2[/COLOR]_Click()
[COLOR="Blue"]Range("A2:D" & Rows.Count) = Empty[/COLOR]
On Error Resume Next
DOSYA = ThisWorkbook.Path & "\" & "[COLOR="Blue"]veri alınacak dosya[/COLOR]" & ".xlsx"
Set Aç = New Excel.Application
Aç.Workbooks.Open DOSYA
Set hz = Aç.Workbooks(Dir(DOSYA))
Set hzs = hz.Sheets("Sayfa2")
x = hzs.Cells(Rows.Count, "C").End(3).Row
i = Cells(Rows.Count, "A").End(3).Row + 1
Cells(i, 1).Select
If Err > 0 Then MsgBox "Bir hata oluştu": GoTo çık
Range("A" & i & ":A" & i + x - 4).Value = hzs.Range("C4:C" & x).Value
Range("C" & i & ":D" & i + x - 4).Value = hzs.Range("H4:I" & x).Value
çık:
hz.Close SaveChanges:=False
Aç.Quit
Set Aç = Nothing: Set hz = Nothing
End Sub[/SIZE]