Soru Veri çekilecek kitap adı tanımlama

  • Konuyu başlatan Konuyu başlatan tukayf
  • Başlangıç tarihi Başlangıç tarihi

tukayf

Normal Üye
Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Sub calisangrubugetir()
Dim dosya As String

dosya_isminde_gecen_kelime = "Grup"

ChDir "C:\Users\Public\Downloads"

With Application.FileDialog(msoFileDialogFilePicker)
.Title = "KAYNAK BELGEYİ SEÇ": .InitialFileName = "*" & dosya_isminde_gecen_kelime & "*.xls*": .AllowMultiSelect = False
If .Show = False Then
Exit Sub
Else
dosya = .SelectedItems(1)
End If
End With

If Not dosya = Empty Then
Set S1 = Sheets("GGL")
Set kitap = GetObject(dosya)




S2.Range("D7:D18").Copy
S1.Range("D7").PasteSpecial Paste:=xlPasteValues
S2.Range("H7:H18").Copy
S1.Range("H6").PasteSpecial Paste:=xlPasteValues
S2.Range("L7:L18").Copy
S1.Range("L7").PasteSpecial Paste:=xlPasteValues
S2.Range("P7:P18").Copy
S1.Range("P7").PasteSpecial Paste:=xlPasteValues
S2.Range("T7:T18").Copy
S1.Range("T7").PasteSpecial Paste:=xlPasteValues
S2.Range("D22:D43").Copy
S1.Range("D22").PasteSpecial Paste:=xlPasteValues
S2.Range("H22:H43").Copy
S1.Range("H22").PasteSpecial Paste:=xlPasteValues
S2.Range("L22:L43").Copy
S1.Range("L22").PasteSpecial Paste:=xlPasteValues
S2.Range("P22:P53").Copy
S1.Range("P22").PasteSpecial Paste:=xlPasteValues
S2.Range("D45:D49").Copy
S1.Range("D45").PasteSpecial Paste:=xlPasteValues
S2.Range("D52:D53").Copy
S1.Range("D52").PasteSpecial Paste:=xlPasteValues
S2.Range("H45:H47").Copy
S1.Range("H45").PasteSpecial Paste:=xlPasteValues
S2.Range("H49").Copy
S1.Range("H49").PasteSpecial Paste:=xlPasteValues
S2.Range("H52:H53").Copy
S1.Range("H52").PasteSpecial Paste:=xlPasteValues
S2.Range("L45:L49").Copy
S1.Range("L45").PasteSpecial Paste:=xlPasteValues
S2.Range("L52:L53").Copy
S1.Range("L52").PasteSpecial Paste:=xlPasteValues
S2.Range("D57:D66").Copy
S1.Range("D57").PasteSpecial Paste:=xlPasteValues
S2.Range("H57:H66").Copy
S1.Range("H57").PasteSpecial Paste:=xlPasteValues
S2.Range("L57:L66").Copy
S1.Range("L57").PasteSpecial Paste:=xlPasteValues
S2.Range("P57:P66").Copy
S1.Range("P57").PasteSpecial Paste:=xlPasteValues
S2.Range("T21:T22").Copy
S1.Range("T21").PasteSpecial Paste:=xlPasteValues
S2.Range("T24:T25").Copy
S1.Range("T24").PasteSpecial Paste:=xlPasteValues
S2.Range("T27:T28").Copy
S1.Range("T27").PasteSpecial Paste:=xlPasteValues
S2.Range("T30:T31").Copy
S1.Range("T30").PasteSpecial Paste:=xlPasteValues
S2.Range("T33").Copy
S1.Range("T33").PasteSpecial Paste:=xlPasteValues
S2.Range("T35").Copy
S1.Range("T35").PasteSpecial Paste:=xlPasteValues
S2.Range("T37").Copy
S1.Range("T37").PasteSpecial Paste:=xlPasteValues
S2.Range("T39").Copy
S1.Range("T39").PasteSpecial Paste:=xlPasteValues
S2.Range("T41").Copy
S1.Range("T41").PasteSpecial Paste:=xlPasteValues
S2.Range("T43").Copy
S1.Range("T43").PasteSpecial Paste:=xlPasteValues
S2.Range("T45").Copy
S1.Range("T45").PasteSpecial Paste:=xlPasteValues
S2.Range("T64:T66").Copy
S1.Range("T64").PasteSpecial Paste:=xlPasteValues
K2.Close 0

Set K1 = Nothing
Set S1 = Nothing
Set K2 = Nothing
Set S2 = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Veriler aktarılmıştır.", vbInformation


End Sub
Merhabalar. Veri çekilecek dosyayı açtırma kodu Ömer Baran Bey'in kodları. Alt taraftaki kodlar ise kopyalanacak hücreler. Ancak veri çekeceğim dosyayı tanımlayamadım. Rica etsem yukardaki kodda düzeltme yapabilir misiniz.
 
Üst