Çözüldü Kapalı dosyadan veri alma

[tukayf]

Aynı ağda aynı klasör içerisinde 1-Ocak, 2-Şubat,..... diye giden 12 kitap içerisindeki Genel sayfalarında bulunan B3:d32 ve B33:b39 satırları 2019 kitabının(tek sayfa var) Ocak sekmesinin B3:B32 ve B33:b 39una alınacak. Formülle oluşturuyorum ancak sürekli olarak başvuru hatası alıyorum. Ağda bulunduğundan dolayı mı hata veriyor.

 

[Orion1]

Aynı ağda aynı klasör içerisinde 1-Ocak, 2-Şubat,..... diye giden 12 kitap içerisindeki Genel sayfalarında bulunan B3:d32 ve B33:b39 satırları 2019 kitabının(tek sayfa var) Ocak sekmesinin B3:B32 ve B33:b 39una alınacak. Formülle oluşturuyorum ancak sürekli olarak başvuru hatası alıyorum. Ağda bulunduğundan dolayı mı hata veriyor.

1 ocak dosyasında değerler başvuru hatası veriyor.

 

[tukayf]

Hocam dosyada 31 sayfa var. Genel sayfasi ise onlari topla formuluyle topluyor. Diger sayfalar olmadigi icin formuller hata veriyor.

LG-H815 cihazımdan Tapatalk kullanılarak gönderildi

 

[Orion1]

Dosyanız ektedir.
Yol ve dosya adını kendi klasöerlerinize göre ayarlayınız.

Sub kopyalayapistir59()
Dim sh As Worksheet, yol As String, dosya As String
Set sh = Sheets("Sayfa1")
yol = ThisWorkbook.Path & "\Yeni klasör\"
dosya = "1-Ocak.xlsm"
Workbooks.Open (yol & dosya)
Range("B3:D32").Copy
sh.Range("B3").PasteSpecial xlPasteValuesAndNumberFormats
Range("B33:B39").Copy
sh.Range("B33").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
ActiveWorkbook.Close False
End Sub

 

[tukayf]

Cok tesekkurler hocam.

LG-H815 cihazımdan Tapatalk kullanılarak gönderildi

 

[Orion1]

Rica ederim.
İyi çalışmalar.

 

[Orion1]

Bütün aylar için aşağıdaki kodları kullanın.
Önceki yazdığım kodları silin.
Aktar prosedürünü kullanın.her 2 prosedürü kopyalayın.

Public yol As String
Sub aktar59()
yol = ThisWorkbook.Path & "\Yeni klasör\"
'"B" 2019 dosyasında yapıştırılacak sayfadaki yapıştırılacak sütun  oluyor.
Call kopyalayapistir59("1-Ocak.xlsm", "B")
End Sub

Sub kopyalayapistir59(ByVal dosya As String, ByVal sutun As String)
Dim sh As Worksheet
Set sh = Sheets("Sayfa1")
'yol = ThisWorkbook.Path & "\Yeni klasör\"
'dosya = ("1-Ocak.xlsm")
Workbooks.Open (yol & dosya)
Range("B3:D32").Copy
sh.Range(sutun & "3").PasteSpecial xlPasteValuesAndNumberFormats
Range("B33:B39").Copy
sh.Range(sutun & "33").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
ActiveWorkbook.Close False
End Sub

 

[tukayf]

Tesekkurler hocam.

LG-H815 cihazımdan Tapatalk kullanılarak gönderildi