Eski Excel Dosyasını "Gözat" Bölümü İle Seçip Verileri Yeni Dosyaya Aktarma

[CRAYZLOVEIS]

imalat bölümü.xls dosyasının thisworkbook modülünde bulunan kodların tümünü silin.

Üstad kusura bakma kafanı karıştırdım sanırım ama Türkiye'nin muhtelif yerlerinde 20 den fazla şubeden gelecek dosyaların veri aktarımını yapacağım. Bazı dosyalarda şifre yok kaldırırım ama bazıları şifreli. Bu nedenle o kodları silemiyorum. Olmayacaksa şansımıda fazla zorlamak istemem. Bu şekilde bile beni büyük bir yükten kurtardınız. Allah Razı Olsun...

 

[Levent Menteşoğlu]

Açılan bir dosyadaki kodun çalışmasını engellemek bana pek olası gelmedi, hele birde şifreli ise mümkün değil. Bence siz bu şekilde çalıştırın.

 

[CRAYZLOVEIS]

Hocam Sağol bu bile benim için yeterli...

 

[viva_emptiness]

Merhaba,

Benimde benzer bir problemim var. Kullanıcıya GetOpenFileName ile bir workbook seçmesini sağlıyorum. Seçilen workbookta bir tane sheet var. O sheeti aynen şuanda kullanılan workbook'a eklemek istiyorum. Aşağıdaki kodda sonsat ve adrs kelimelerinin nasıl kullanıldıklarını anlayamadım.

Yardımcı olursanız sevinirim.

Alternatif olarak aşağıdaki kodu deneyin.

Sub verial()
ad = ThisWorkbook.Name
Range("A2:F65536").ClearContents
Application.ScreenUpdating = False
dosya = Application.GetOpenFilename("Excel Dosyası (*.xls),*.xls", , "Hedef Dosyayı Seçin")
If dosya = False Then Exit Sub
Workbooks.Open Filename:=dosya
sonsat = ActiveWorkbook.ActiveSheet.Cells(65536, "A").End(xlUp).Row
If sonsat < 2 Then Exit Sub
adrs = Range(Cells(2, "A"), Cells(sonsat, "F")).Address
Workbooks(ad).Sheets(1).Range(adrs).Value = ActiveWorkbook.ActiveSheet.Range(adrs).Value
ActiveWorkbook.Close False
Application.ScreenUpdating = True
MsgBox "Aktarma gerçekleşti..!!", vbOKOnly + vbInformation, "AKTARMA"
Range("A1").Select
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin. Kodda kopyalanacak sayfa adının "liste" olduğu kabul edilmiştir. Bu adı kendinize göre değiştirebilirsiniz.

Sub verial()
ad = ThisWorkbook.Name
say = ActiveWorkbook.Sheets.Count
Application.ScreenUpdating = False
dosya = Application.GetOpenFilename("Excel Dosyası (*.xls),*.xls", , "Hedef Dosyayı Seçin")
If dosya = False Then Exit Sub
Workbooks.Open Filename:=dosya
ad2 = ActiveWorkbook.Name
Workbooks(ad2).Sheets("liste").Copy After:=Workbooks(ad).Sheets(say)
Workbooks(ad2).Close False
Application.ScreenUpdating = True
MsgBox "Aktarma gerçekleşti..!!", vbOKOnly + vbInformation, "AKTARMA"
End Sub