Birden çok sütuna yapışmayı nasıl önleyebilirim?

Question

VBA'da oldukça yeniyim ve aşağıdaki kod snippet'inde tek bir sorunla karşılaştım. Hedefim, bir kullanıcı verileri manuel olarak bir tabloya yapıştırdığında satır eklemektir. Kullanıcı, tablonun bir bölümünü el ile kopyalar (A1'den C25'e kadar diyelim. D ve E'ye dokunmadan bırakılır) ve A26'ya elle yapıştırılırken satırlar eklenir. Bu şekilde, tablo, verileri düzgün bir şekilde sığdırmak için genişler (çünkü tabloda daha fazla içerik vardır).

Şimdi, aşağıda gösterilen kod sorta çalışıyor, tek sorun şu ki (A'dan C'ye kadar) sütunlardaki yapıştırılan veriler tüm sütunlarda tekrarlanıyor (D'den F'ye, G'den I'ye, vs ..)

nasıl komut çubuğunun geri alma kontrolü bu çünkü kullanıyorum

' When cells are pasted, insert # of rows to paste in 
Dim lastAction As String 
' If a Paste action was the last event in the Undo list 
lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1) 
If Left(lastAction, 5) = "Paste" Then 
    ' Get the amount that was pasted (table didn't expand) 
    numOfRows = Selection.Rows.Count 
    ' Undo the paste, but keep what is in the clipboard 
    Application.Undo 
    ' Insert a row 
    ActiveCell.offset(0).EntireRow.Insert 
End If 

nedeni ("sonsuza kadar" devam ve itibaren) Ben eklenen satırlarda benim diğer sütunları üzerine yazmasını bu yapıştırılan verileri engellerim kodun elle yapıştırma etkinliğinde çalışması gerekir.

Answer 1

Bunu bir vuruş yapın. Verileri panodan kaldırdım, ancak önce bir değişkene sakladım, böylece satırlar eklenebilir, ardından veriler uygun yere eklenir ve diğer sütunlar boş bırakılır.

Private Sub Worksheet_Change(ByVal Target As Range) 

' If a Paste action was the last event in the Undo list 
Dim lastAction As String 
lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1) 

If Left(lastAction, 5) = "Paste" Then 

    Dim rng() As Variant 
    rng() = Target 

    numofRows = Target.Rows.Count 'get amount of rows pasted 
    numofColumns = Target.Columns.Count 'get amount of columns pasted 

    With Application 
     .EnableEvents = False 'stop events from firing momentarily 
     .Undo 'undo paste action 
     .CutCopyMode = False 'remove data from clipboard 
    End With 

    ActiveCell.Resize(numofRows, 1).EntireRow.Insert 'insert new amount of rows based on paste 

    ActiveCell.Resize(numofRows, numofColumns).Value = rng() 'replace pasted values 

    Application.EnableEvents = True 'turn back on event firing 

End If 

End Sub