makro kopyalama esnasında tarihler sayılara dönüyor hatası

[Cihannalbant]

makro ile çalışma sayfalarına kopyalamayapıyorum. Ancak tarih sutunlarını kopyaladığımda bicimi değişiyor ve tarih ler sayı biçimine dönüşüyor. HEK ve LİSTE sayfalarında

MAKRO bilgim çok değil bana yardımcı olur musunuz ?

Hedef hücre biçimini değiştirsem bile tekrar kopyalama yapıldığında hepsi birden sayıya dönüyor.

Belgemi ekliyorum yardımcı olursanız sevinirim

 

[Cihannalbant]

KAYITLI OLAN MAKRO BU ARKADAŞLAR AMA L VE M SUTUNLARI TARİH KOPYALAMASI GEREKİRKEN 44208 GİBİ KOPYALIYOR. HÜCRE BİÇİMİ TARİH YAPTIĞIMDA DÜZELİYOR HER KOPYALAMADA TEKRAR ESKİ HATALI HALİNE DÖNÜYOR


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Baglanti As Object, Kayit_Seti As Object, Sorgu As String

If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub

Set Baglanti = CreateObject("AdoDb.Connection")
Set Kayit_Seti = CreateObject("AdoDb.Recordset")

Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""

Sorgu = "Select * From [GENEL$A:S] Where F1 = 'HEK'"

Kayit_Seti.Open Sorgu, Baglanti, 1, 1

With Sheets("HEK")
.Cells.Clear
If Kayit_Seti.RecordCount > 0 Then
Sheets("GENEL").Range("A1:S1").Copy .Range("A1")
.Range("A2").CopyFromRecordset Kayit_Seti
.Columns.AutoFit
End If
End With

If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
If Baglanti.State <> 0 Then Baglanti.Close

Set Kayit_Seti = Nothing
Set Baglanti = Nothing

If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub

Set Baglanti = CreateObject("AdoDb.Connection")
Set Kayit_Seti = CreateObject("AdoDb.Recordset")

Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""

Sorgu = "Select * From [GENEL$A:S] Where F1 = 'LİSTE'"

Kayit_Seti.Open Sorgu, Baglanti, 1, 1

With Sheets("LİSTE")
.Cells.Clear
If Kayit_Seti.RecordCount > 0 Then
Sheets("GENEL").Range("A1:S1").Copy .Range("A1")
.Range("A2").CopyFromRecordset Kayit_Seti
.Columns.AutoFit
End If
End With

If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
If Baglanti.State <> 0 Then Baglanti.Close

Set Kayit_Seti = Nothing
Set Baglanti = Nothing
End Sub





KAYITLI OLAN MAKRO BU ARKADAŞLAR AMA L VE M SUTUNLARI TARİH KOPYALAMASI GEREKİRKEN 44208 GİBİ KOPYALIYOR. HÜCRE BİÇİMİ TARİH YAPTIĞIMDA DÜZELİYOR HER KOPYALAMADA TEKRAR ESKİ HATALI HALİNE DÖNÜYOR

 

[Ömer]

Merhaba,

Öncelikle mesajlarınızın tümünde büyük harf kullanmaya özen göstermenizi rica ederim.

Eski kodların yerine:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Baglanti As Object, Kayit_Seti As Object, Sorgu As String, syf As String
   
    If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub
   
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
   
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
 
    syf = Target.Value
    
    On Error GoTo atla
    With Sheets(syf)
    
        Sorgu = "Select * From [GENEL$A:S] Where F1 = '" & syf & "' "

        Kayit_Seti.Open Sorgu, Baglanti, 1, 1

        .Cells.Clear
        If Kayit_Seti.RecordCount > 0 Then
            Sheets("GENEL").Range("A1:S1").Copy .Range("A1")
            .Range("A2").CopyFromRecordset Kayit_Seti
            .[L:M].NumberFormat = "dd.mm.yyyy"
            .Columns.AutoFit
        End If
        
    End With
   
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close

    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
atla:
    Exit Sub
End Sub