- Katılım
- 5 Eylül 2007
- Mesajlar
- 1,247
- Excel Vers. ve Dili
- ofis 2010
iyi günler;
bu kod ile muavin isimli sayfayı , Sayfa1' çekiyorum. bazı sayfalarda veri alış satır ve sütün ları değiştirmem gerekiyor, tahmini olara 1,3 kodlarla oyna yaptığımda hata veriyor. veri alış satır-sütun numarasını nasıl ayarlayabilirim. Teşekkürler.
Kod:
Sub muavin()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Dim conn As Object, rs As Object, sonsat As Long
Set conn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
sonsat = Cells(Rows.Count, "A").End(xlUp).Row + 1
conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.Path & "\muavin.xlsx;extended properties=""excel 12.0;hdr=no;imex1"""
rs.Open "select * from [Sayfa1$];", conn, 1, 3
Application.ScreenUpdating = False
If rs.RecordCount > 0 Then Range("A" & sonsat).CopyFromRecordset rs
Application.ScreenUpdating = True
rs.Close
conn.Close
Set rs = Nothing: Set conn = Nothing
Sheets("Sayfa1").Select
Sheets("Sayfa1").Range("A2:I" & Range("I65656").End(3).Row).Font.Name = "Calibri" 'yazı fontu
Sheets("Sayfa1").Select
Sheets("Sayfa1").Range("A2:J" & Range("J65656").End(3).Row).Font.Size = 10 'yazı tipi boyutu
'Sheets("VERI").Select ' konumlanma
Sheets("Sayfa1").Select
Sheets("Sayfa1").Range("D:G" & Range("G65656").End(3).Row).NumberFormat = "#,##0.00"
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub
Ekli dosyalar
Son düzenleme:
