Aktar Makrosunda Düzenleme

[ormann]

İyi günler;
Ekli Harcırah1 dosyasında Veri Al Butonunu tıkladığımda açılan klasörden ise ekli Harcırah2 klasörünü seçtiğimde veriler Harcırah dosyasından alınarak Harcırah1 dosyasına geliyor.Fakat Harcırah2 içerisinde yaptığınız değişiklikleri kaydetmek istiyor musunuz ? diye uyarı veriyor.Bu uyarıyı vermeden verileri alınca otomatik olarak kapatabilir mi?
http://dosya.co/bjhpzb341k72/Harcırah1.rar.html
http://dosya.co/4m2edmaglhww/Harcırah2.rar.html

Dim Dosya As Variant
Sub VeriAl()
    On Error Resume Next
    Dim XDosya As Workbook
    Dim xAlan As Range
       Dim Time1 As Date, Time2 As Date
    Dim timeElapsed As String, myFile As String
      
       Sheets("VERİ GİRİŞİ").Unprotect 1978
       Sheets("HARCIRAH").Unprotect 1978
      Sheets("VERİ GİRİŞİ").Rows("11:41").Hidden = False
      Sheets("HARCIRAH").Rows("11:41").Hidden = False
     Dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyası,*.xls; *.xlsb; *.xlsx; *.xlsm", MultiSelect:=True)
    If Dosya(1) = Empty Then
        Time1 = Now
        MsgBox "Lütfen önce Dosya seçiniz.", vbExclamation
        Exit Sub
    End If
    Set xAlan = Workbooks.Open(Dosya(1)).Worksheets("veri girişi").Range("e4:L41")
    ThisWorkbook.Worksheets("veri girişi").Range("e4:L41") = xAlan.Value
    xAlan.Parent.Parent.Close
Sheets("VERİ GİRİŞİ").Protect 1978
Sheets("HARCIRAH").Protect 1978
  Time2 = Now
    timeElapsed = Format(Time2 - Time1, "ss") & " Saniye"
    MsgBox "İşlem süresi: " & timeElapsed, vbInformation

End Sub

 

[turist]

Deneyin.

Dim Dosya As Variant
Sub VeriAl()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    On Error Resume Next
    Dim XDosya As Workbook
    Dim xAlan As Range
    Dim Time1 As Date, Time2 As Date
    Dim timeElapsed As String, myFile As String
    Sheets("VERİ GİRİŞİ").Unprotect 1978
    Sheets("HARCIRAH").Unprotect 1978
    Sheets("VERİ GİRİŞİ").Rows("11:41").Hidden = False
    Sheets("HARCIRAH").Rows("11:41").Hidden = False
    Dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyası,*.xls; *.xlsb; *.xlsx; *.xlsm", MultiSelect:=True)
    If Dosya(1) = Empty Then
        Time1 = Now
        MsgBox "Lütfen önce Dosya seçiniz.", vbExclamation
        Exit Sub
    End If
    Set xAlan = Workbooks.Open(Dosya(1)).Worksheets("veri girişi").Range("e4:L41")
    ThisWorkbook.Worksheets("veri girişi").Range("e4:L41") = xAlan.Value
    xAlan.Parent.Parent.Close
Sheets("VERİ GİRİŞİ").Protect 1978
Sheets("HARCIRAH").Protect 1978
  Time2 = Now
    timeElapsed = Format(Time2 - Time1, "ss") & " Saniye"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "İşlem süresi: " & timeElapsed, vbInformation
End Sub

 

[ormann]

Sayın Turist çok teşekkür ederim

 

[turist]

Sayın Turist çok teşekkür ederim

Sağ olun.