makro ile veri tasima

[erkandeveci]

Elimde 2 adet dosyaa var burada yapmak istediğim porföydeki mşeri numaraları ile burdaki müşteri numarasını baz alarak kırmzı ile işaretlediğiim verilerin makro ile getirlmesi eğer portföyde farklı müşteri de var ise listeye eklemesini bunu yapabilirmiyiz.. şimdiden teşekkür ederim..

 

[asi_kral]

Merhaba
Peki raporlamada var olup da portföyde olmayan için ne yapılacak_?

 

[erkandeveci]

o o kadar onemli degil ama raporlamda var olup portoyde olmayanlari da farkli sheet e alabirsek .ok guzel olur.

 

[erkandeveci]

merhaba arkadaşlar yardımcı olurabilirseniz çok sevinirim...

 

[asi_kral]

merhaba arkadaşlar yardımcı olurabilirseniz çok sevinirim...

Merhaba
Raporlama Kitabında boş bir module ekleyin ve deneyin.

Option Explicit
Sub veri_bul_1967()
'Konu       :   Başka Dosyadan Veri Al
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim ASİ As Excel.Application, K1 As Workbook
Dim A1 As String, A2 As String, YOL As String
Dim A1S1 As Worksheet, A2S1 As Worksheet, SAT As Long
Dim BUL As Long
Application.ScreenUpdating = False
A1 = ActiveWorkbook.Name
Set A1S1 = Workbooks(A1).Sheets(ActiveSheet.Name)
A1S1.Range("B2:F" & Rows.Count).ClearContents
A1S1.Range("K2:K" & Rows.Count).ClearContents
A1S1.Range("S2:S" & Rows.Count).ClearContents
A1S1.Range("U2:Y" & Rows.Count).ClearContents
A1S1.Range("AC2:AE" & Rows.Count).ClearContents
YOL = ThisWorkbook.Path & "\"
A2 = "PORTFÖY.xlsx"
Set K1 = Workbooks.Open(YOL & A2)
Set A2S1 = K1.Sheets("AAAAA")
With WorksheetFunction
For SAT = 2 To A1S1.Range("A" & Rows.Count).End(xlUp).Row
If .CountIf(A2S1.Range("D:D"), A1S1.Cells(SAT, "A")) > 0 Then
BUL = .Match(A1S1.Cells(SAT, "A"), A2S1.Range("D:D"), 0)
A1S1.Cells(SAT, "B") = A2S1.Cells(BUL, "BT")
A1S1.Cells(SAT, "C") = A2S1.Cells(BUL, "BM")
A1S1.Cells(SAT, "D") = A2S1.Cells(BUL, "B")
A1S1.Cells(SAT, "E") = A2S1.Cells(BUL, "C")
A1S1.Cells(SAT, "F") = A2S1.Cells(BUL, "E")
A1S1.Cells(SAT, "K") = A2S1.Cells(BUL, "BL")
A1S1.Cells(SAT, "S") = A2S1.Cells(BUL, "BH")
A1S1.Cells(SAT, "U") = A2S1.Cells(BUL, "F")
A1S1.Cells(SAT, "V") = A2S1.Cells(BUL, "H")
A1S1.Cells(SAT, "W") = A2S1.Cells(BUL, "L")
A1S1.Cells(SAT, "X") = A2S1.Cells(BUL, "U")
A1S1.Cells(SAT, "Y") = A2S1.Cells(BUL, "BK")
A1S1.Cells(SAT, "AC") = A2S1.Cells(BUL, "X")
A1S1.Cells(SAT, "AD") = A2S1.Cells(BUL, "BF")
A1S1.Cells(SAT, "AE") = A2S1.Cells(BUL, "BD")
End If: Next
SAT = A1S1.Range("A" & Rows.Count).End(xlUp).Row + 1
For BUL = 2 To A2S1.Range("D" & Rows.Count).End(xlUp).Row
If .CountIf(A1S1.Range("A:A"), A2S1.Cells(BUL, "D")) = 0 Then
A1S1.Cells(SAT, "A") = A2S1.Cells(BUL, "D")
A1S1.Cells(SAT, "B") = A2S1.Cells(BUL, "BT")
A1S1.Cells(SAT, "C") = A2S1.Cells(BUL, "BM")
A1S1.Cells(SAT, "D") = A2S1.Cells(BUL, "B")
A1S1.Cells(SAT, "E") = A2S1.Cells(BUL, "C")
A1S1.Cells(SAT, "F") = A2S1.Cells(BUL, "E")
A1S1.Cells(SAT, "K") = A2S1.Cells(BUL, "BL")
A1S1.Cells(SAT, "S") = A2S1.Cells(BUL, "BH")
A1S1.Cells(SAT, "U") = A2S1.Cells(BUL, "F")
A1S1.Cells(SAT, "V") = A2S1.Cells(BUL, "H")
A1S1.Cells(SAT, "W") = A2S1.Cells(BUL, "L")
A1S1.Cells(SAT, "X") = A2S1.Cells(BUL, "U")
A1S1.Cells(SAT, "Y") = A2S1.Cells(BUL, "BK")
A1S1.Cells(SAT, "AC") = A2S1.Cells(BUL, "X")
A1S1.Cells(SAT, "AD") = A2S1.Cells(BUL, "BF")
A1S1.Cells(SAT, "AE") = A2S1.Cells(BUL, "BD")
SAT = SAT + 1
End If: Next
End With
K1.Close
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Dosyanız ekte.

 

[erkandeveci]

çok teşekkür ederim çok işime yaradı...Emeğinize sağlık...

 

[asi_kral]

çok teşekkür ederim çok işime yaradı...Emeğinize sağlık...

Kolay Gelsin.

 

[erkandeveci]

merhaba bu dosya ya ek olarak ekteki gecikme dosyasındaki müşterileri bulup raporlama dosyasındaki Q ve R sütununa getirebilirmiyiz.teşekkür ederim

 

[erkandeveci]

sayın asi kral yardımcı olursanız çok sevinirm şimdiden teşekkür ederim.

 

[erkandeveci]

asi kral biraz geç oldu ama ekteki gecikme workbook unu da aynı portföy gibi yanına taşıyabilirmiyiz.
teşekkür ederim.

 

[erkandeveci]

tekarar özetlemem gerekirse;
ekteki gecikme ve uyar excel dosyarlınıda rapoarlamaya portföy dosyasından veri taşımasına ilave olarak (makroya ilave excel dosyası ekleme)

Uyar excelindeki E sütununu raporlama excel dosyasındaki P sütununa (Müşteri numarasına göre getirmesini)
gecikme excel dosasyındaki E ve Fsütununu (gecikme gün gecikme tutarı
)raporlamadaki Q ve R sütununa portföyden ilave makro ekleyebilrmiyiz.

şimdiden teşekkür ederim.iyi bayramlar..

 

[erkandeveci]

arkadaşlar tekrar merhaba acil yardıma ihtiyacım var ..