Açık excel dosyasının içeriğinde belli bölgeyi kopyala sonra sunucu içerisindeki başka excel dosyasını aç yapıştır kaydet kapat

dgdizayn

Altın Üye
Katılım
7 Mart 2011
Mesajlar
138
Excel Vers. ve Dili
OFFİCE 2019 EN
Altın Üyelik Bitiş Tarihi
04-05-2028
Merhabalar,

Açık excel dosyasının içeriğinde belli bölgeyi kopyala sonra sunucu içerisindeki başka kapalı excel dosyasını aç içerisine yapıştır kaydet kapat istiyorum bu mümkün müdür acaba. Google ve buradan vs arattırdım ama yanlışmı aratıyorum bilemedim bir türlü bulamadım. Bulduğum kodlarda çalışmadı, bu konuda yardımlarınızı bekliyorum.
Çok teşekkürler.
 

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Deneyiniz..

Kod:
Option Explicit

Sub Verileri_Aktar()
    Dim KynkSyf As Worksheet, Hdf As Workbook, HdfSyf As Worksheet
    Dim Yol As String, Dosya_Adi As String, Zamn As Date, sonsatir As Integer
    Application.ScreenUpdating = False
    Zamn = Time
    
    Set KynkSyf = ThisWorkbook.ActiveSheet
    
    Yol = "C:\Masaüstü\"            'Kapalı Dosyanın yolu
    Dosya_Adi = "Kapali Dosya.xlsx" 'Kapalı Dosyanın Adi
 
    Set Hdf = Workbooks.Open(Yol & Dosya_Adi, False, False)
    Set HdfSyf = Hdf.Sheets("Sayfa1") 'Kapalı Dosyanın Sayfa adi
              
    sonsatir = HdfSyf.Cells(Rows.Count, "A").End(3).Row + 1
    HdfSyf.Range("A" & sonsatir & ":C" & sonsatir + 598).Value = KynkSyf.Range("O2:Q600").Value
        
    
    Hdf.Close True
    Application.ScreenUpdating = True
    MsgBox Format(Time - Zamn, "hh:mm:ss") & " Surede Islem Tamamlandi" & vbLf & Application.UserName, vbInformation
    
End Sub
 
Son düzenleme:

dgdizayn

Altın Üye
Katılım
7 Mart 2011
Mesajlar
138
Excel Vers. ve Dili
OFFİCE 2019 EN
Altın Üyelik Bitiş Tarihi
04-05-2028
Deneyiniz..

Kod:
Option Explicit

Sub Verileri_Aktar()
    Dim KynkSyf As Worksheet, Hdf As Workbook, HdfSyf As Worksheet
    Dim Yol As String, Dosya_Adi As String, Zamn As Date
    Application.ScreenUpdating = False
    Zamn = Time
   
    Set KynkSyf = ThisWorkbook.ActiveSheet
   
    Yol = "C:\Masaüstü\"            'Kapalı Dosyanın yolu
    Dosya_Adi = "Kapali Dosya.xlsx" 'Kapalı Dosyanın Adi

    Set Hdf = Workbooks.Open(Yol & Dosya_Adi, False, False)
    Set HdfSyf = Hdf.Sheets("Sayfa1") 'Kapalı Dosyanın Sayfa adi
             
    HdfSyf.Range("A1:C10").Value = KynkSyf.Range("A1:C10").Value
   
    Hdf.Close True
    Application.ScreenUpdating = True
    MsgBox Format(Time - Zamn, "hh:mm:ss") & " Surede Islem Tamamlandi" & vbLf & Application.UserName, vbInformation
   
End Sub
EmrExcel16 Hocam çok ama çok teşekkür ederim. Umarım herkes içinde faydalı olur. Birşey daha istesem acaba yardımcı olur musunuz.

Başka dosyaya yapıştırırken en dolu hücreden sonraki boş hücreye sayı formatında (yani formülsüz) yapıştırma yapabilir miyiz.
 

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba , Verdiğim kodlarda kopyalama işlemi formulsuz olarak yapılmakta , bunun için birşey yapmaya gerek yok . Ama hücreler konusunda biraz bilgi verirmisiniz yada , kopyalanacak veri sabit mi değişken mi .
 

dgdizayn

Altın Üye
Katılım
7 Mart 2011
Mesajlar
138
Excel Vers. ve Dili
OFFİCE 2019 EN
Altın Üyelik Bitiş Tarihi
04-05-2028
Hocam kaynak yer O2:Q600 arası kopyalayacak, hedef dosyada ise A sütununda en son dolu hücreden sonraki boş hücreye yapıştıracak. Döngü hep böyle olacak.
 

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
2 nolu mesajda verdiğim kodları bu doğrultuda değiştirdim , deneyiniz..
 
Üst