Kullanıcı
- Katılım
- 27 Ocak 2019
- Mesajlar
- 155
- Excel Versiyonu
- Excel 2016
- Excel Sürümü
- 64 Bit
- Excel Dili
- Türkçe
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.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