Dosyadan Ekle Makrosu

[whirlybird]

Arkadaşlar merhaba, konu belki size göre çok basit ama ben işin içinden çıkamadım. Makro ile başka bir excelden veri çekmek istiyorum. Evet bu basit ancak sorun olan kısım o bahsettiğim verilerin çekileceği excelin ismi ve yolu değişken. Özetlemem gerekirse "Dosyadan Ekle" adında bir düğme yaptım ona tıklayınca bir pencere açılacak hangi excelden veri çekeceksem onu seçtiğim zaman "A" ve "B" sütunlarından veriler alınıp benim "Sayfa1"! excelime aktaracak.

Hani foruma resim ekle düğmesine tıklayınca yükelenecek resim seçilip yükleniyor ya onun gibi bir şey yapmak istiyorum. Yardımcı olacak kişilere şimdiden teşekkür ederim.

 

[Ömer BARAN]

Veri çekme ile ilgili forumda çok sayıda çözümlü örnek var.

Sanırım dosya seçimi işiyle ilgili takıldınız.

Aşağıdaki kod satırını, mevcut veri çekme kodlarının ilk satırı olarak yapıştırırsanız,
düğmeye tıkladığınızda veri çekilecek excel belgesinin seçimi için GÖZAT ekranı açılacaktır.

dosya = Application.GetOpenFilename("Excel Belgesi (*.xls*),*.xls*", , "Hedef Dosyayı Seçin")

 

[turist]

Arkadaşlar merhaba, konu belki size göre çok basit ama ben işin içinden çıkamadım. Makro ile başka bir excelden veri çekmek istiyorum. Evet bu basit ancak sorun olan kısım o bahsettiğim verilerin çekileceği excelin ismi ve yolu değişken. Özetlemem gerekirse "Dosyadan Ekle" adında bir düğme yaptım ona tıklayınca bir pencere açılacak hangi excelden veri çekeceksem onu seçtiğim zaman "A" ve "B" sütunlarından veriler alınıp benim "Sayfa1"! excelime aktaracak.

Hani foruma resim ekle düğmesine tıklayınca yükelenecek resim seçilip yükleniyor ya onun gibi bir şey yapmak istiyorum. Yardımcı olacak kişilere şimdiden teşekkür ederim.

Örnek olarak deneyin:

Sub DosyaSec()
  With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Excel Dosyası", "*.xls* ", 1
        .Show
          dosyayolu = .SelectedItems.Item(1)
    End With
        If InStr(dosyayolu, ".xls") = 0 Then
        Exit Sub
    End If
Workbooks.Open dosyayolu
'bundan sonra açtığınız dosya ile işlemlerinizin kodları yazılır.....
End Sub

 

[whirlybird]

Örnek olarak deneyin:

Sub DosyaSec()
  With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Excel Dosyası", "*.xls* ", 1
        .Show
          dosyayolu = .SelectedItems.Item(1)
    End With
        If InStr(dosyayolu, ".xls") = 0 Then
        Exit Sub
    End If
Workbooks.Open dosyayolu
'bundan sonra açtığınız dosya ile işlemlerinizin kodları yazılır.....
End Sub

Peki ben bu dosyayı açmadan dosya yolundaki excelin sayfa1 a1:a10 hücrelerindeki veriyi, satis.xls'deki (üzerinde çalışılan excelin adıdır), sayfa1 a1:a10 hücrelerine nasıl aktarabilirim?

 

[turist]

Aşağıdaki kodu "satis.xls" dosyanızda deneyin.

Sub DosyaSec()
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Excel Dosyası", "*.xls* ", 1
        .Show
          dosyayolu = .SelectedItems.Item(1)
    End With
        If InStr(dosyayolu, ".xls") = 0 Then
        Exit Sub
    End If
Workbooks.Open dosyayolu
Sheets("Sayfa1").Range("A1:A10").Copy
    ActiveWindow.Close
  Sheets("Sayfa1").Activate
      Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

 

[whirlybird]

Aşağıdaki kodu "satis.xls" dosyanızda deneyin.

Sub DosyaSec()
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Excel Dosyası", "*.xls* ", 1
        .Show
          dosyayolu = .SelectedItems.Item(1)
    End With
        If InStr(dosyayolu, ".xls") = 0 Then
        Exit Sub
    End If
Workbooks.Open dosyayolu
Sheets("Sayfa1").Range("A1:A10").Copy
    ActiveWindow.Close
  Sheets("Sayfa1").Activate
      Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

İmzanızdaki gibi 40 yıl duacınız olacağım, tam aradığım şekilde oldu çok teşekkür ederim.

 

[turist]

İmzanızdaki gibi 40 yıl duacınız olacağım, tam aradığım şekilde oldu çok teşekkür ederim.

Sağ olun, var olun.

 

[whirlybird]

Çok özür dilerim tekrardan soru eklemek zorunda kaldım.
Şimdi ben makroyu çalıştırıyorum dosya aç ekranı açılıyor ya orada vazgeçip iptal diyorum o zaman debug hatası veriyor. Yani illa dosya seçmem gerekiyor dosya seçmeyip iptal dersem hata veriyor bunu ne şekilde çözebiliriz?

 

[turist]

Aşağıdaki kodu kullanabilirsiniz.

Sub DosyaSec()
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Excel Dosyası", "*.xls* ", 1
        .Show
        If .SelectedItems.Count = 0 Then
        MsgBox "Dosya seçilmedi,İşlem iptal edildi"
    Else
          dosyayolu = .SelectedItems.Item(1)
          End If
    End With
        If InStr(dosyayolu, ".xls") = 0 Then
        Exit Sub
    End If
    On Error Resume Next
Workbooks.Open dosyayolu
Sheets("Sayfa1").Range("A1:A10").Copy
    ActiveWindow.Close
  Sheets("Sayfa1").Activate
      Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub