Kapalı excel dosyasından veri almak

[kadir78]

İyi günler. İki dosya var. Kaynak.xlsx ve Hedef.xlsm
Bana lazım olan ise Hedef.xlsm dosyası açık konumda iken, kapalı olan Kaynak.xlsx dosyasının ilk sekiz satırını silmek ve Kaynak.xlsx dosyasının çalışma sayfasını (Sayfa1), Hedef.xlsm dosyasına makro kodları ile aktarmak. Bunun için bir makro kodu varmı acaba. Yardımcı olabilirmisiniz.

Not : Kaynak.xlsx dosyasının içinde sadece 1 adet çalışma sayfası var "Sayfa1".
Dosyaların ikiside aynı klasör içerisinde.

 

[askm]

İki dosyanızdan örnek eklerseniz kod yazmaya çalışalım.

 

[kadir78]

Sayın askm. Normalde ben bu işlemi çabuk yapıyorum, fakat iş yerimdeki diğer arkadaşlar excel den fazla anlamıyor. Bunun için bana makro kodu lazım. Ben olmadığım zamanda kolayca yapabilmeleri için lazım. Örnek dosyam yok çünkü 100 den fazla farklı dosya var. Boş excel de çalışsa bile olur. Bana Makro kodu lazım. 100 den fazla dosyaya uyarlama yapmam gerekiyor. Her excel dosyası farklı faklı yapılmış. Bana taban bir makro kodu lazım. Bende kodları dosyalara uyarlayacağım. Eğer ilgilenirseniz minnettar olacağım. İyi günler.

 

[askm]

Formun arama sayfasında yüzlerce örnek mevcut. Bunları kullanabilirsiniz.
http://www.excel.web.tr/search.php?searchid=3084110

 

[kadir78]

Sayın Hocalarım. Mümkünse bu konu hakkında Makro kodu bilen varmı acaba, lütfen yardımcı olur musunuz. İyi günler.

 

[PLİNT]

Merhaba
Tam açıklama yapmamışsınız; ne kadar satır, sütun aktarılacak?
"xlsm" dosyasının "sayfa1" inde veri varmı son satırdan itibarenmi aktarılacak?
Sayfa silinecekmi? Olmuş şekliyle bir örnek taslak dosya iyi olacaktır ama aşağıdaki kodlar işinizi görürse bir deneyin.

[SIZE="2"]Sub AKTAR()
Dim wb As Workbook
Set wb = ThisWorkbook
wb.Sheets.Add Type:=ThisWorkbook.Path & "\KAYNAK.xlsx"
ActiveSheet.Move After:=wb.Sheets(1)
wb.Sheets(1).Rows("1:8").Delete Shift:=xlUp
wb.Sheets(1).Name = "KAYNAK SAYFASI"
ActiveSheet.Cells(1).Select
End Sub [/SIZE]

 

[EmrExcel16]

Bende bir örnek vereyim deneyin hedef dosyasında boş bir modül açıp kodu yapıştırın

Sub kopyala()

Application.ScreenUpdating = False

    Workbooks.Open Filename:=ActiveWorkbook.Path & "\Kaynak.xlsx"
    Sheets("Sayfa1").Rows("1:8").Delete
    Sheets("Sayfa1").Copy After:=Workbooks("Hedef.xlsm").Sheets(1)
    Workbooks("Kaynak.xlsx").Close SaveChanges:=False
    
Application.ScreenUpdating = True

End Sub

 

[kadir78]

Saygıdeğer Hocalarım. Çok teşekkür ederim. Kodlar işime yaradı. Kendime göre küçük ayarlamalar yaptım. Allah hepinizden razı olsun, elleriniz dert görmesin. Hayırlı günler.

 

[5353]

Sub AKTAR()
Dim wb As Workbook
Set wb = ThisWorkbook
wb.Sheets.Add Type:=ThisWorkbook.Path & "\Report.xls"
ActiveSheet.Move After:=wb.Sheets(1)
wb.Sheets(1).Rows("1:8").Delete Shift:=xlUp
wb.Sheets(1).Name = "\Users\murat.topal\Downloads"
ActiveSheet.Cells(1).Select
End Sub

Dosyayı bulamıyor hatası alıyorum. Çözüm var mı ?
Kapalı dosya ‪"C:\Users\murat.topal\Downloads\Report.xls" burada.
Açık Dosya başka bir yerde ?