Haftalık rapora otomatik sütun ekleme ve silme.

[U4US_ist]

Merhaba arkadaşlar.

Haftalık rapor olarak tuttuğum bir excel var. Sadece son 5 haftayı tutuyorum. Yeni haftada bir sütun yaratıp en eski olanı silmem lazım. Yeni oluşturduğum sütunun da bir önceki ile format ve formulleri ile kopyalamam lazım.

Bunu makro ile nasil yapabilirim bilen varsa yardımcı olabilir mi bana acaba ?

 

[dEdE]

Merhaba,
Aşağıdaki kodu dener misiniz?

Sub Test1()
    ss = Sheets("Sayfa1").Cells(Rows.Count, "B").End(3).Row
    Range("G1").AutoFill Destination:=Range("G1:H1")
    Range("G2:G" & ss).Copy Range("H2")
    Columns(3).Delete
End Sub

Not: Eğer yanıt istediğiniz gibi değilse, örnek dosya paylaşır mısınız?

 

[AdemCan]

Merhaba alternatif.

Sub test_ekle()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
Dim s1 As Worksheet, son As Long, baslik As String, i As Byte

Set s1 = Sayfa1: son = s1.Range("B" & Rows.Count).End(xlUp).Row
baslik = s1.Range("G1")
i = Right(baslik, Len(baslik) - WorksheetFunction.Search(" ", baslik)) * 1 + 1

With s1
    .Range("G1:G" & son).Copy .Range("H1")
    .Range("H1") = "Week " & i
    .Columns(3).EntireColumn.Delete
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

 

[U4US_ist]

çok teşekkür ederim. Elinize sağlık. Örnek tabloyu iletirken atlamışım benim hatam ..

Tabloyu farklı bir kolona taşıyıp koddaki kolon ve hücre isimlerini de ona göre düzelttikten sonra yeni kolon oluşturdu ama eskisini silmedi.

 

[dEdE]

Altın Üyesiniz, dosya paylaşabilirsiniz.
Yukarıdaki resim yerine dosyayı paylaşırsanız, kısa sürede çözülür.
Lütfen istediğinizi tam ve doğru olarak açıklayınız.

 

[U4US_ist]

Kusura bakmayın atlamışım.. tşklr.

Bir tablom var. tablomda sadece 5 haftalık veriyi tutuyoruz. Her hafta başı geldiğinde en eski haftaya ait kolonu silip yeni haftayı varolan son haftanın yanına insert ediyorum ve akabinde bir önceki kolonun formatını ve formülü ile kopyalıyorum.

 

[dEdE]

Aşağıdaki kodu örnek dosyanızda Modüle yapıştırarak dener misiniz?

Sub Test()
    ss = Sheets("Sheet1").Cells(Rows.Count, "G").End(3).Row
    Range("L1").AutoFill Destination:=Range("L1:M1")
    Range("L2:L" & ss).Copy Range("M2")
    Columns(8).Delete
End Sub

 

[U4US_ist]

çok teşekkür ederim. "Columns(8).Delete" gözden kaçırmışım tekrar soruya gerek yokmuş. zahmet verdim.