Soru Son Dolu Sütun Yanına Ekle

[Yaren Eslem]

A - B - C Sütunlarım veri içermekte, Makro ile D Sütunu eklemem gerekiyor, eklerken de bir önceki sütun biçimlendirmesi ve formül içeriğini de alması gerekiyor. Yani kısaca: Dolu olan en son sütun yanına ekleme yapsın, içeriği bozulmasın gibi... Nasıl yapabilirim?

Yardımcı olabilir misiniz?

 

[muhasebeciyiz]

Sub YeniSutunEkle()
    Dim ws As Worksheet
    Dim lastCol As Integer
    Dim newCol As Integer
    
    Set ws = ActiveSheet   
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    newCol = lastCol + 1
    
    ws.Columns(newCol).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove   
    ws.Columns(lastCol).Copy
    ws.Columns(newCol).PasteSpecial Paste:=xlPasteFormats
    ws.Columns(newCol).PasteSpecial Paste:=xlPasteFormulas
    
    Application.CutCopyMode = False

    MsgBox "Yeni sütun eklendi ve biçimlendirme kopyalandı!", vbInformation
End Sub

Bu makroyu çalıştırdığınızda, en son dolu sütunun sağında yeni bir sütun oluşturulur ve önceki sütunun tüm biçimlendirme ve formülleri korunur.

 

[Yaren Eslem]

İlginize çok teşekkür ediyorum,

kodu çalıştırdığımda ilk sütunun yanına ekleme yapıyor, ve o sütunun biçimlendirmesini baz alıyor (Sütun genişliği)

Son dolu sütun yanına ekleme olmadı maalesef.

 

[Yaren Eslem]

Bu şekilde deneyip sonucu paylaşabilir misiniz;

Sub AddColumnWithFormattingAndFormulas()
    Dim ws As Worksheet
    Dim lastCol As Long
  
    Set ws = ActiveSheet
  
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    ws.Columns(lastCol + 1).Insert Shift:=xlToRight

    ws.Cells(1, lastCol + 1).Value = "Yeni Sütun"
  
    ws.Columns(lastCol).Copy
    ws.Columns(lastCol + 1).PasteSpecial Paste:=xlPasteFormats
    ws.Columns(lastCol + 1).PasteSpecial Paste:=xlPasteFormulas
  
    Application.CutCopyMode = False
End Sub

Bütün ilgili kişilere teşekkürler, hakkınızı helal edin. Her iki paylaşılan kodda doğru, sorun; benim "F4" Baz alacak demediğim için kaynaklandı. Tekrar kusura bakmayın lütfen. Düzeltmeyi yaptım sorun yok.