Believing
Altın Üye
- Katılım
- 19 Mayıs 2013
- Mesajlar
- 700
- Excel Vers. ve Dili
-
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
- Altın Üyelik Bitiş Tarihi
- 23-08-2028
Sayın Uzman arkadaşlar,
Aşağıdaki alıntı olan kod ile kapalı çalışma kitabından veri alıyorum.
Veriyi aldığım alanın "A6:L2999" dışında kalan "M" sütununu yardımcı sütun olarak kullanarak formül üretiyorum.
Kodları çalıştırdığımda .Range("A6:L2999").ClearContents bu alının dışına taşarak "M" sütunundaki formülleri de silmektedir.
Bu durumu düzeltmek için mevcut kodu nasıl revize etmeliyim?
Saygılarımla,
Aşağıdaki alıntı olan kod ile kapalı çalışma kitabından veri alıyorum.
Veriyi aldığım alanın "A6:L2999" dışında kalan "M" sütununu yardımcı sütun olarak kullanarak formül üretiyorum.
Kodları çalıştırdığımda .Range("A6:L2999").ClearContents bu alının dışına taşarak "M" sütunundaki formülleri de silmektedir.
Bu durumu düzeltmek için mevcut kodu nasıl revize etmeliyim?
Saygılarımla,
Kod:
Sub Database_Verilerini_Guncelle()
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Con As Object, Rs As Object
Dim dosya As String
dosya = ThisWorkbook.Path & "\Database_SANAL.xls"
Set Con = CreateObject("adodb.connection")
Set Rs = CreateObject("adodb.recordset")
With Sayfa9
.Range("A6:L2999").ClearContents
Con.Open "provider=microsoft.ACE.oledb.12.0;data source=" & dosya & _
";extended properties=""Excel 12.0;hdr=no"""
Rs.Open "select * from [Sheet1$]", Con, 1, 1
If Rs.RecordCount > 0 Then
.Range("A6").CopyFromRecordset Rs
End If
Rs.Close: Con.Close
End With
Sayfa9.Select
Set Rs = Nothing: Set Con = Nothing
dosya = vbNullString
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'MsgBox "VERİLERİNİZ GÜNCELLENMİŞTİR.", vbInformation
End Sub