Otomatik Satır ve Formül Ekleme

[bjk55]

Merhaba, örnek dosyayı ekte gönderdim. Satış sayfamda bulunan tabloyu dzt sayfasına satır ve formül ekleyerek düzeltmesini istiyorum nasıl yapabilirim

 

[kulomer46]

Dosyanız Hazır.

Selamlar...

 

[bjk55]

Dosyanız Hazır.

Selamlar...

Elinize sağlık çok teşekkür ederim Mükemmel oldu Peki bunun açılımını biraz yazabilir misiniz .Mesala nasıl oldu da Dzt i basınca otomatik excel düzenleniyor

 

[kulomer46]

Merhaba

Makro kodu yazdık. Şöyleki aşağıdaki şekildede görüldüğü gibi DZT sayfasının Worksheet_Activite olayına aşağıdaki kodları yazıp ekledik.

Böyle oluncada DZT sayfası her tıklanıp aktif olduğunda kodlar çalışıyor..
Kodlarıda sonucu güzel olacak şekilde biraz görsel olarak süsledik.
Verimli bir sonuç çıktı.

Selamlar...

Private Sub Worksheet_Activate()
'20.05.2019    14:58

    c = MsgBox("Satış Sayfasından Kopyalama işlemi Başlatılacaktır." & Chr(10) & Chr(10) & "Onaylıyor musunuz?", vbOKCancel)
    If c = vbCancel Then End
  
    Application.EnableEvents = True
    Application.ScreenUpdating = True
  
    Cells.Clear
    Cells(1, 1).Select
  
    timer1 = Timer
    Do While Timer - timer1 < 0.2
    Loop
  
    Cells.Clear
  
    timer1 = Timer
    Do While Timer - timer1 < 0.2
    Loop
  
    Cells.Clear
  
    timer1 = Timer
    Do While Timer - timer1 < 0.2
    Loop

    Application.EnableEvents = False
    Application.ScreenUpdating = False
  
    Sheets("SATIŞ").Cells.Copy
    Sheets("dzt").Select
    Cells.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    Range("C3").Select
    ActiveWorkbook.Save

    Application.EnableEvents = True
    Application.ScreenUpdating = True 
  
başauç1:
  
    For i = 3 To Cells(Rows.Count, 10).End(3).Row 
  
        If Trim(Cells(i, 10)) = "AMERIKAN DOLARI" And Cells(i + 1, 2) <> 360.9 Then     
    
                Rows(i + 1 & ":" & i + 1).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Rows(i & ":" & i).Select
                Selection.Copy
                Rows(i + 1 & ":" & i + 1).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                 Range(Cells(i + 1, 1), Cells(i + 1, 17)).Interior.Color = RGB(255, 255, 0)
              
                Cells(i + 1, 2) = "'" & 360.9
                Cells(i, 8) = Cells(i - 1, 7) / 1.001
                Cells(i, 8).NumberFormat = "#,##0.00"
                Cells(i, 8).Font.Color = RGB(255, 0, 0)
                Cells(i, 8).Font.Bold = True
                Cells(i + 1, 8) = Cells(i, 8) / 1000 * 1
                Cells(i + 1, 8).NumberFormat = "#,##0.00"
                Cells(i + 1, 8).Font.Color = RGB(255, 0, 0)
                Cells(i + 1, 8).Font.Bold = True
              
                Cells(i + 1, 10) = ""
                Cells(i + 1, 11) = ""
                Cells(i + 1, 12) = ""
                Cells(i + 1, 13) = ""
      
                GoTo başauç1
          
        End If 
  
    Next
  
Cells(1, 1).Select

MsgBox "Aktarma Tamamlandı  :) "

End Sub

 

[bjk55]

teşekkür ederim

 

[kulomer46]

teşekkür ederim

Selamlar...

 

[bjk55]

Selamlar...

Tekrardan Merhaba, makro sadece Amerikan Doları yazınca çalışıyor diğer para birimlerini yazınca çalışmıyor Yapmaya çalıştım ama yapamadım müsait olduğunuz zaman onları da ekleyebilir misiniz

 

[kulomer46]

Dosyanız talebinize uygun son haliyle Ek' tedir.

Selamlar...

 

[bjk55]

Dosyanız talebinize uygun son haliyle Ek' tedir.

Selamlar...

Emeğinize ve bilginize sağlık. Tekrar teşekkür ederim. Kolay gelsin

 

[bjk55]

Dosyanız talebinize uygun son haliyle Ek' tedir.

Selamlar...

şimdi birşey dikkatimi çekti 360,9 alıyor 360.9 noktalı olması gerek değiştirmeye çalıştım ama yine virgül olarak atıyor

 

[kulomer46]

Merhaba

Dosyanız Son Haliyle Hazır

 

[bjk55]

Tekrar Merhaba müsait olduğunuz zaman bu yolladığım dosya içinde aynı şekilde hazır makro oluşturabilir misiniz . Bunda formülü alttan alıyor ama bilginiz olsun

 

[bjk55]

Merhaba

Dosyanız Son Haliyle Hazır

 

[kulomer46]

Merhaba

Yoğunluğum çok fazla. Müsait olursam dönüş yaparım.

Selamlar...