Я пытаюсь объединить несколько динамических столбцов в один столбец на новом листе.Я написал код, который передает выбор, сделанный из нескольких выпадающих меню, в которых пользователь может выбрать несколько вариантов в своей собственной ячейке.Я пытаюсь создать функцию, которая переносит эти выборы в один столбец на новом листе.Если бы кто-нибудь мог сказать мне, как перенести этот изменяющийся диапазон строк в пределах приблизительно 8 столбцов в новый лист, который был бы великолепен, или если бы проще было непосредственно поместить выборки на новый лист, который также работал бы.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Row = 11 Then
Dim rng As Range, cell As Range
Set rng = Range("A11:H11")
For Each cell In rng
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Dim val As String
val = ActiveCell.Value
ActiveCell.Offset(0, 9).Value = val
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & "; " & Newvalue
'below begins addition from Shanell
Dim txt As String
Dim i As Integer
Dim FullName As Variant
txt = ActiveCell.Value
FullName = Split(txt, ";")
For i = 0 To UBound(FullName)
ActiveCell.Offset(i, 9).Value = FullName(i)
Next i
Else:
Target.Value = Oldvalue
End If
End If
End If
Next cell
End If
Set rng = ActiveCell.CurrentRegion
lastCell = rng.Columns(1).Rows.Count + 1
'Attempt to copy to new sheet'
For iCol = 11 To rng.Columns.Count
Range(Cells(11, iCol), Cells(rng.Columns(iCol).Rows.Count, iCol)).Cut
ActiveSheet.Paste Destination:=Worksheets("Links").Range("lastCell,A3")
lastCell = lastCell + rng.Columns(iCol).Rows.Count
Next iCol
Я пробовал этот код, и нет ошибок, но значения не отображаются на новом листе.Я добавил комментарий, в котором я пытаюсь скопировать значения на новый лист.
Я также попробовал строку кода, подобную этой:
Range("J11", Range("Q11").End(xlDown)).Copy Worksheets("Links").Range("A3:A")
Однако это тоже не сработало.