- Katılım
- 22 Eylül 2007
- Mesajlar
- 247
- Excel Vers. ve Dili
- Türkçe 2016
- Altın Üyelik Bitiş Tarihi
- 29-08-2024
makroyla ağdaki kapalı dosyalardan veri alıyorum. Fakat bu dosyaya ek yapmak istiyorum forumda TextBox lara yazdırılanları buldum ama kullandığım makroya ekleyemedim. Form açıldığında kapalı dosyayı seçip birim sayfasına ekliyorum. Açığım dosyanın yolunun sayfa1 de a1 hücresine dosya yolunu a2 hücresine dosya adının yazılmasını istiyorum.
Private Sub CommandButton5_Click()
Sheets("BİRİM").Select
Sheets("BİRİM").Range("a1:Ah2500").ClearContents
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "excel 2007-13", "*.xlsx;*.xlsm;*.xls"
AllowMultiSelect = False
.Show
If .SelectedItems.Count = 0 Then
MsgBox "excel dosyası sec"
Exit Sub
End If
kopya = InputBox("Koplayanacak hücre aralığını yazınız", Default:="A1:AE5000")
yapiştir = InputBox("yapıştırılacak hücreyi yazınız", Default:="b1")
Application.Workbooks.Open .SelectedItems(1)
Set kaynak = Application.ActiveWorkbook
'kaynak.Sheet("b").Range(kopya).Copy("b").Range (yapiştir)
kaynak.ActiveSheet.Range(kopya).Copy ThisWorkbook.ActiveSheet.Range(yapiştir)
kaynak.Close False
Set kaynak = Nothing
End With
MsgBox "BİRİM_MALİK İşlemi tamam...", vbInformation
End Sub
teşekkürler
Private Sub CommandButton5_Click()
Sheets("BİRİM").Select
Sheets("BİRİM").Range("a1:Ah2500").ClearContents
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "excel 2007-13", "*.xlsx;*.xlsm;*.xls"
AllowMultiSelect = False
.Show
If .SelectedItems.Count = 0 Then
MsgBox "excel dosyası sec"
Exit Sub
End If
kopya = InputBox("Koplayanacak hücre aralığını yazınız", Default:="A1:AE5000")
yapiştir = InputBox("yapıştırılacak hücreyi yazınız", Default:="b1")
Application.Workbooks.Open .SelectedItems(1)
Set kaynak = Application.ActiveWorkbook
'kaynak.Sheet("b").Range(kopya).Copy("b").Range (yapiştir)
kaynak.ActiveSheet.Range(kopya).Copy ThisWorkbook.ActiveSheet.Range(yapiştir)
kaynak.Close False
Set kaynak = Nothing
End With
MsgBox "BİRİM_MALİK İşlemi tamam...", vbInformation
End Sub
teşekkürler
Ekli dosyalar
-
16.6 KB Görüntüleme: 3