kapalı dosyaya veri yazma

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
Altın Üyelik Bitiş Tarihi
22-12-2019
Kod:
Sub Z_RAPOR()
tanimlamalar
dosyaadı = Mid(bfl.Range("G4"), 5, 4)
  sayfaadı = Mid(bfl.Range("G4"), 3, 2)
  
   Workbooks.Open (ThisWorkbook.Path & "\" & dosyaadı & ".xls")
   Workbooks(dosyaadı).Activate
Sheets(sayfaadı).Select
sonbfl = bfl.Cells(Rows.Count, "B").End(3).Row

sonsatır = Cells(Rows.Count, "B").End(3).Row + 1
Range("A" & sonsatır & ":I" & (sonsatır + sonbfl - 4)).Value = bfl.Range("A4:I" & sonbfl).Value
 Workbooks(dosyaadı).Save

 Workbooks(dosyaadı).Close
End Sub
Kod:
Sub Z_RAPOR2()

Dim Con As Object, Rs As Object, Sorgu As String
 Application.ScreenUpdating = False
tanimlamalar
    Set Con = CreateObject("Adodb.Connection")
    Set Rs = CreateObject("Adodb.RecordSet")
    
  dosyaadı = Mid(bfl.Range("G4"), 5, 4)
  sayfaadı = Mid(bfl.Range("G4"), 3, 2)
  
If Win64 And VBA7 Then
        Con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
  ThisWorkbook.Path & "\" & dosyaadı & ".xls" & "Extended Properties=""Excel 12.0 Xml;HDR=YES"""
Else
            Con.Open "provideR=microsoft.jet.oledb.4.0;data source=" & _
   ThisWorkbook.Path & "\" & dosyaadı & ".xls" & ";extended properties=""excel 8.0;hdr=yes"""
End If
Sorgu = "SELECT *  FROM  [02$] WHERE BarkodNumarasi LIKE '" & "" & "%'"
        
        Rs.Open Sorgu, Con, 1, 3


For i = 4 To bfl.Cells(Rows.Count, "B").End(3).Row
 Rs.addnew
 For stn = 1 To 9

     Rs(stn - 1).Value = bfl.Cells(i, stn)
  
   
        Next
         Rs.Update
     Next
    Con.Close
    Set Con = Nothing: Set Rs = Nothing: Sorgu = ""
     Application.ScreenUpdating = True
End Sub

Merhaba arkadaşlar,

Var olan açık dosyadan kapalı dosyaya veri aktarımı için hangisi daha sağlıklı olur sizce ?


İlkinde sayfa biçimleri olduğu gibi geçiyor fakat ileride veriler 6000 satırlara geldiğinde dosyanın açılıp kapanma süresi uzar diye düşünüyorum.

ikincisinde ise sadece biçim sorunum var .
 
Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
Altın Üyelik Bitiş Tarihi
22-12-2019
Önerisi olan yok mu?

:hey:
 
Üst