Как исправить этот код для копирования значений в столбцы? - PullRequest
0 голосов
/ 09 января 2019

Всякий раз, когда значение в ячейке B2 листа sheet1 изменяется, значение копируется и вставляется в столбец sheet2 в следующей пустой ячейке. Мне нужно изменить это, чтобы вставить значения в строку 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

Ответы [ 2 ]

0 голосов
/ 09 января 2019

Добавление этого ответа на запрос в комментариях.

Сначала вы захотите создать лист - это может быть скрытый лист - этот код сделает это за вас, но вы можете сделать это вручную.

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 на этом листе для хранения последнего использованного столбца.

Вы захотите изменить свой worksheet_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
0 голосов
/ 09 января 2019

Это то, что вы ищете?

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...