Makro ile bir başka dosyadan veri alma

[ferhatiscan]

Değerli arkadaşlar Merhaba,

Öncelikle, insanların ihtiyaçlarını giderebilmek adına böylesine faydalı bir ortam hazırladıkları için forum yönetimine teşekkürlerimi sunarım. Konumuza gelecek olursak;

Fazla makro bilgim olmamasına rağmen, benim de iş yerimde uygulamaya çalıştığım bir iş emri yönetimi sayfası var. Bu makrodan beklentim şu;
Şablon sayfa: iş emri şablonunun olduğu, verilerin "iş emri" excelinden çekilip yazılacağı tablo
İş emri sayfası: Verileri barındıran sayfa. Buradaki veriler makro ile şablon sayfasına taşınacak

1- Şablon sayfa içeriğini temizle
2- iş emri sayfasındaki ilk satırdaki verileri al, şablon sayfasındaki belirtilen hücrelere ekle.
3- Şablon sayfasındaki sekmeyi kopyala
4- Yeni sekmede(Şablon sayfadaki yeni sekme) sayfa içeriğini temizle
5- İş emri sayfasındaki 2.satırdaki(sırasıyla tüm satırlardaki verileri alacak) verileri al, şablon sayfasındaki belirtilen hücrelere ekle.
6- Şablon sayfasındaki sekmeyi kopyala
.
.
Döngü bu şekilde olacak.
7- "İş emri sayfası"nda dolu satılar bittiğinde(yani alınacak veri kalmadığında) "İşlem tamamlandı" vb. uyarı ile döngüyü durdur.

ekteki dosyalardan da göreceğiniz üzere belirli bir yere kadar geldim. Fakat, ilk satırdan sonraki verileri aldıramıyorum.Yani satırları sırasıyla taratıp, tüm satırlardaki verileri alamıyorum. bu konuda yardımlarınız rica ederim. Şimdiden teşekkürler.


Ek-dosya:

 

[halit3]

Modül1 deki kod

Sub Sekme_Kopyala()
ThisWorkbook.Worksheets(1).Copy After:=ThisWorkbook.Worksheets(1)
End Sub

Userform1 deki kod

Private Sub CommandButton1_Click()


Range("c6").ClearContents
Range("c8").ClearContents
Range("c10").ClearContents
Range("c12").ClearContents
Range("G8").ClearContents
Range("G10").ClearContents
Range("G12").ClearContents


'XLSX Import
' Get customer workbook...
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook

' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ThisWorkbook

' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"


caption = "Lütfen Dosya Seçiniz "

customerFilename = Application.GetOpenFilename(filter, , caption)
TextBox1 = customerFilename ' Dosya yolunu textbox1'e yazdırır
Set customerWorkbook = Application.Workbooks.Open(customerFilename)


' assume range is A1 - C10 in sheet1
' copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)

For i = 2 To Worksheets(1).Cells(Rows.Count, "A").End(3).Row
'1.Döngü
targetSheet.Range("C6").Value = sourceSheet.Range("A" & i).Value
targetSheet.Range("C8").Value = sourceSheet.Range("B" & i).Value
targetSheet.Range("C10").Value = sourceSheet.Range("C" & i).Value
targetSheet.Range("C12").Value = sourceSheet.Range("D" & i).Value
targetSheet.Range("G6").Value = sourceSheet.Range("E" & i).Value
targetSheet.Range("G8").Value = sourceSheet.Range("F" & i).Value
targetSheet.Range("G10").Value = sourceSheet.Range("G" & i).Value

Call Sekme_Kopyala
Next i
' Close customer workbook
customerWorkbook.Close

MsgBox "Import İşlemi Başarıyla Tamamlandı!" & Alt _

End Sub

 

[halit3]

Kodu birazcık daha sadeleştirdim.

Private Sub CommandButton1_Click()

Range("c6").ClearContents
Range("c8").ClearContents
Range("c10").ClearContents
Range("c12").ClearContents
Range("G8").ClearContents
Range("G10").ClearContents
Range("G12").ClearContents

Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook

filter = "Text files (*.xlsx),*.xlsx"

caption = "Lütfen Dosya Seçiniz "
customerFilename = Application.GetOpenFilename(filter, , caption)
TextBox1 = customerFilename ' Dosya yolunu textbox1'e yazdırır
Set customerWorkbook = Application.Workbooks.Open(customerFilename)

For i = 2 To customerWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(3).Row
MsgBox customerWorkbook.Worksheets(1).Name
ThisWorkbook.Worksheets(1).Range("C6").Value = customerWorkbook.Worksheets(1).Range("A" & i).Value
ThisWorkbook.Worksheets(1).Range("C8").Value = customerWorkbook.Worksheets(1).Range("B" & i).Value
ThisWorkbook.Worksheets(1).Range("C10").Value = customerWorkbook.Worksheets(1).Range("C" & i).Value
ThisWorkbook.Worksheets(1).Range("C12").Value = customerWorkbook.Worksheets(1).Range("D" & i).Value
ThisWorkbook.Worksheets(1).Range("G6").Value = customerWorkbook.Worksheets(1).Range("E" & i).Value
ThisWorkbook.Worksheets(1).Range("G8").Value = customerWorkbook.Worksheets(1).Range("F" & i).Value
ThisWorkbook.Worksheets(1).Range("G10").Value = customerWorkbook.Worksheets(1).Range("G" & i).Value
ThisWorkbook.Worksheets(1).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Next i
customerWorkbook.Close

MsgBox "Import İşlemi Başarıyla Tamamlandı!" & Alt _

End Sub

 

[ferhatiscan]

Halit Hocam Merhaba,

İlgilendiğin için teşekkür ederim. Fakat makro çalıştıktan sonra ilgili alanlara, alakasız veriler getiriyor. Bir kayma mı mevcut acaba?

 

[halit3]

Halit Hocam Merhaba,

İlgilendiğin için teşekkür ederim. Fakat makro çalıştıktan sonra ilgili alanlara, alakasız veriler getiriyor. Bir kayma mı mevcut acaba?

3 nolu mesajdaki kodu güncelledim.

 

[ferhatiscan]

3 nolu mesajdaki kodu güncelledim.

Çok teşekkür ederim Halit hocam.
İyi çalışmalar...

 

[halit3]

Çok teşekkür ederim Halit hocam.
İyi çalışmalar...

Teşekkürler iyi çalışmalar