如何修复此代码以将值复制到列中?

问题描述 投票:0回答:2

只要sheet1的单元格B2中的值发生更改,就会复制值并将其粘贴到下一个空白单元格中的sheet2列A中。我需要更改它以将值粘贴到ROW 2,即A2,B2,C2。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
a = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & a).Value = 
Sheets("Sheet1").Range("B2").Value
End If
End Sub
excel vba
2个回答
1
投票

在评论中为请求添加此答案。

您首先要创建一个工作表 - 可以是隐藏工作表 - 此代码将为您执行此操作,但您可以随意手动执行此操作。

Sub Create_Hidden_Control_sheet()

    Dim ws As Worksheet
    With ThisWorkbook
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    End With

    ws.Name = "Control"

    ws.Visible = xlSheetVeryHidden

    ws.Range("A1") = "Last cell used"
    ws.Range("B1") = 0

End Sub

您将使用此工作表上的单元格B1来存储最后使用的列。

您需要更改workheet_change以执行此操作

Private Sub Worksheet_Change(ByVal Target As Range)

Dim a As Integer

If Target.Address = "$B$2" And Target.Value > 0 Then

    a = Sheets("Control").Range("B1") + 1

    If a > 10 Then
        a = 1
    End If

    Sheets("Sheet2").Cells(2, a) = Sheets("Sheet1").Range("B2").Value

    Sheets("Control").Range("B1") = a

End If

End Sub

2
投票

这就是你要追求的吗?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim v_target_row As Integer

If Target.Address = "$B$2" Then

    v_target_row = 2

    If Sheets("Sheet2").Cells(v_target_row, 1) = "" Then
        a = 0
    Else
        a = Sheets("Sheet2").Cells(v_target_row, Sheets("Sheet2").Columns.Count).End(xlToLeft).Column
    End If
    Sheets("Sheet2").Cells(v_target_row, a + 1) = Sheets("Sheet1").Range("B2").Value
End If

End Sub
© www.soinside.com 2019 - 2024. All rights reserved.