DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
merhaba,Merhaba;
Sizin dosyanız için hazırlanmış olan aşağıdaki kod biraz daha basit olup, yaptığım denemelerde olumlu sonuç aldım.
Çok da hızlı çalışmaktadır.
.Kod:Sub Verileri_AL() 'Haluk - 22/11/2017 Range("B3:J102").ClearContents Dosya = Application.GetOpenFilename If Dosya = False Then Exit Sub mySheet = "HAT PERFORMANSI" Set FSO = CreateObject("Scripting.FileSystemObject") Set myFile = FSO.GetFile(Dosya) filePath = FSO.GetParentFolderName(Dosya) myStr = "='" & filePath & Application.PathSeparator myStr = myStr & "[" & myFile.Name & "]" & mySheet & "'" Range("B3:F102").FormulaArray = myStr & "!D7:H106" Range("G3:J102").FormulaArray = myStr & "!N7:Q106" Range("B3:J102").Copy Range("B3:J102").PasteSpecial xlPasteValues Application.CutCopyMode = False Range("M1").Select End Sub
nihayet altın üyelik sonrasında dosyalarımı gönderebiliyorum.merhaba,
bu kodları ben de kendim için uyarlamak istiyorum ama veri taşıdığım dosyadaki hücreler korumaya alınıyor. Korumayı nasıl kaldırabilirim.
teşekkür ederim,
yardımcı olacak yok munihayet altın üyelik sonrasında dosyalarımı gönderebiliyorum.
Mesele şöyleydi. Bu kodları kendim için uyarladığımda dosya2 ye kopyalanan verilen korumaya giriyor ve üzerinde değişiklik yapmaya müsade etmiyor.
Sub Verileri_AL()
'Haluk - 22/11/2017
[COLOR="Red"]Range("A2:C10").ClearContents[/COLOR]
Dosya = Application.GetOpenFilename
If Dosya = False Then Exit Sub
mySheet = "dosya2"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFile = FSO.GetFile(Dosya)
filePath = FSO.GetParentFolderName(Dosya)
myStr = "='" & filePath & Application.PathSeparator
myStr = myStr & "[" & myFile.Name & "]" & mySheet & "'"
Range("A2:A10").FormulaArray = myStr & "!A2:A10"
Range("B2:B10").FormulaArray = myStr & "!B2:B10"
Range("C2:C10").FormulaArray = myStr & "!C2:C10"
Application.CutCopyMode = False
Range("M1").Select
End Sub