veri aktarımı

[d_yuksel]

üstadlarım. hepinize iyi akşamlar.
hepiniz için çok kolay ama benim için şu anlık yapmam imkansız bir veri aktarımı dosyası yolladım size. isteklerimi aktardım yardımcı olursanız çok ama çok sevinirim.

 

[Orion1]

Dosyanız Ekte.

 

[d_yuksel]

Dosyanız Ekte.

çok ama çok teşekkürler... ellerinize sağlık

 

[Orion1]

çok ama çok teşekkürler... ellerinize sağlık

Rica ederim.
İyi çalışmalar.

 

[d_yuksel]

evren bey son olarak. ben bu SENETLER sayfasını başka çalışma kitabına taşısam. bu kodu nasıl değiştirmem gerekir??

 

[Orion1]

evren bey son olarak. ben bu SENETLER sayfasını başka çalışma kitabına taşısam. bu kodu nasıl değiştirmem gerekir??

Aşağıdaki kodları vbe'de boş bir modüle kopyalyıp çalıştırabilirsiniz.

Sub Düğme3_Tıklat()
Dim sat As Long, i As Byte
Sheets("Ana Sayfa").Select
Set s2 = Sheets("Senetler")
sat = s2.Cells(65536, "B").End(xlUp).Row + 1
If sat >= 65533 Then
    MsgBox "Sayfada satır sayısı doldu.Başka kayıt yapılamaz..!!", vbCritical, "DİKKAT"
    Exit Sub
End If
s2.Cells(sat, "A").Value = sat - 2
s2.Cells(sat, "B").Value = Date
s2.Cells(sat, "B").NumberFormat = "dd.mm.yyyy"
For i = 3 To 7
    s2.Cells(sat, i) = Cells(i + 1, "C").Value
Next i
s2.Cells(sat, "H").Value = Cells(10, "C").Value
s2.Cells(sat, "I").Value = Cells(14, "C").Value
s2.Cells(sat, "J").Value = Cells(15, "C").Value
If UCase(Range("C11").Value) = "EVET" Then
    s2.Cells(sat, "K").Value = Range("C13") + (Range("C12") * Range("C14"))
    ElseIf UCase(Replace(Replace(Range("C11").Value, "i", "İ"), "ı", "I")) = "HAYIR" Then
    s2.Cells(sat, "K").Value = Range("C13") + (WorksheetFunction.Sum(Range("B19:B30,D19:D30")))
End If
MsgBox "Veriler aktarıldı..!!", vbOKOnly + vbInformation, Application.UserName
    
End Sub

 

[d_yuksel]

yanlış ifade ettim sanırım.ben aktarım yapılacak sayfayı mesela masaüstünde senetler adlı bir dosya oluştursam o dosyanın içerisine aktarmak için kodu nasıl değiştirmem gerekir.ben bunu sormuştum.

 

[Orion1]

yanlış ifade ettim sanırım.ben aktarım yapılacak sayfayı mesela masaüstünde senetler adlı bir dosya oluştursam o dosyanın içerisine aktarmak için kodu nasıl değiştirmem gerekir.ben bunu sormuştum.

Senetler dosyası açıkmı olacak yoksa kapalımı?

 

[d_yuksel]

kapalı olursa daha iyi olur aslında

 

[Orion1]

Masa üstünüzde Senetler isminde bir dosya oluşturunuz ve Bu dosyada Senetler isminde bir sayfa oluşturunuz.
Dosyayı açıyor,Kaydediyor,ve sonra gene kapatıyor.
Dosyanız ekte.

Sub Düğme3_Tıklat()
Dim sat As Long, i As Byte
Sheets("Ana Sayfa").Select
yol = "C:\Documents and Settings\" & Application.UserName & "\Desktop\"
dosya = "Senetler.xls"
Application.DisplayAlerts = False
Workbooks.Open (yol & dosya)
If ActiveWorkbook.ReadOnly = True Then ActiveWorkbook.Close
Application.DisplayAlerts = True
ThisWorkbook.Activate
sat = Workbooks("Senetler.xls").Sheets("Senetler").Cells(65536, "B").End(xlUp).Row + 1
If sat >= 65533 Then
    MsgBox "Sayfada satır sayısı doldu.Başka kayıt yapılamaz..!!", vbCritical, "DİKKAT"
    Exit Sub
End If
Workbooks("Senetler.xls").Sheets("Senetler").Cells(sat, "A").Value = sat - 2
Workbooks("Senetler.xls").Sheets("Senetler").Cells(sat, 2).Value = Date
Workbooks("Senetler.xls").Sheets("Senetler").Cells(sat, 2).NumberFormat = "dd.mm.yyyy"
For i = 3 To 7
   Workbooks("Senetler.xls").Sheets("Senetler").Cells(sat, i) = Cells(i + 1, 3).Value
Next i
Workbooks("Senetler.xls").Sheets("Senetler").Cells(sat, 8).Value = Cells(10, 3).Value
Workbooks("Senetler.xls").Sheets("Senetler").Cells(sat, 9).Value = Cells(14, 3).Value
Workbooks("Senetler.xls").Sheets("Senetler").Cells(sat, 10).Value = Cells(15, 3).Value
If UCase(Range("C11").Value) = "EVET" Then
    Workbooks("Senetler.xls").Sheets("Senetler").Cells(sat, 11).Value = Range("C13") + (Range("C12") * Range("C14"))
    ElseIf UCase(Replace(Replace(Range("C11").Value, "i", "İ"), "ı", "I")) = "HAYIR" Then
    Workbooks("Senetler.xls").Sheets("Senetler").Cells(sat, 11).Value = Range("C13") + (WorksheetFunction.Sum(Range("B19:B30,D19:D30")))
End If
Workbooks("Senetler.xls").Close True
MsgBox "Veriler aktarıldı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub