简体   繁体   中英

Copy drop-down list and conditional formatting to new cell with Excel VBA

I have the following to copy a range of free text boxes to another series of cells, which works as I want it to:

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 & 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

In my original fields, in box J4, I have a drop down list. How do I copy this to the new location and maintain the list functionality? I also want to add conditional formatting to the selections in this box so would like this carried forward also?

If you copy (rather than Copy followed by PasteSpecial ) a cell, the data validation will copy with it:

在此处输入图片说明

the code:

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

the result:

在此处输入图片说明

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM