Otomatik Satır ve Formül Ekleme

bjk55

Altın Üye
Katılım
29 Mart 2010
Mesajlar
174
Excel Vers. ve Dili
TÜRKÇE - MİCROSOFT OFFİCE PROFESSİONAL PLUS 2021
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
 

Ekli dosyalar

bjk55

Altın Üye
Katılım
29 Mart 2010
Mesajlar
174
Excel Vers. ve Dili
TÜRKÇE - MİCROSOFT OFFİCE PROFESSİONAL PLUS 2021
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

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,512
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
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...


1558383707960.png

Kod:
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

Altın Üye
Katılım
29 Mart 2010
Mesajlar
174
Excel Vers. ve Dili
TÜRKÇE - MİCROSOFT OFFİCE PROFESSİONAL PLUS 2021
teşekkür ederim
 

bjk55

Altın Üye
Katılım
29 Mart 2010
Mesajlar
174
Excel Vers. ve Dili
TÜRKÇE - MİCROSOFT OFFİCE PROFESSİONAL PLUS 2021
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
 

bjk55

Altın Üye
Katılım
29 Mart 2010
Mesajlar
174
Excel Vers. ve Dili
TÜRKÇE - MİCROSOFT OFFİCE PROFESSİONAL PLUS 2021
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
 

Ekli dosyalar

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,512
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Merhaba

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

Selamlar...
 
Üst