Блог

У меня есть следующее, чтобы скопировать диапазон свободных текстовых полей в другую серию ячеек, которая работает так, как я хочу:

 Public Sub LogEntry()
    'define source range
    Dim SourceRange As Range
    Set SourceRange = ThisWorkbook.Worksheets("Log").Range("C4:J4")

    'find next free cell in destination sheet
    Dim NextFreeCell As Range
    With ThisWorkbook.Worksheets("Log")
        If IsEmpty(.Range("C8").Value) Then
            Set NextFreeCell = .Range("C8")
        Else
            Set NextFreeCell = .Cells(.Rows.Count, "C").End(xlUp).Offset(1)
        End If
    End With
                
    'copy amp; paste
    SourceRange.Copy
    NextFreeCell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    NextFreeCell.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'delete text box
    ThisWorkbook.Save
    Application.Goto Reference:="R4C7:R4C9"
    Application.CutCopyMode = False
    Selection.ClearContents 
End Sub
  

В моих исходных полях, в поле J4, у меня есть выпадающий список. Как мне скопировать это в новое местоположение и сохранить функциональность списка? Я также хочу добавить условное форматирование к выделениям в этом поле, поэтому хотел бы, чтобы это также продолжалось?

Если вы скопируете (а не Copy затем PasteSpecial ) ячейку, проверка данных будет скопирована вместе с ней:

код:

 Sub KopyKat()
    Dim J4 As Range, K5 As Range
    
    Set J4 = Range("J4")
    Set K5 = Range("K5")
    
    J4.Copy K5
End Sub
  

результат: