Мне не удалось найти макрос для перемещения содержимого ячейки без изменения форматирования.
Я собрал макрос ниже, который достигает этого, НО он очищает вставленный диапазон, где он перекрывает скопированный диапазон. Может ли кто-нибудь помочь с кодом, чтобы исключить перекрытие части от очистки?
Sub E____MoveContentsOnlyKeepFormats_SIMPLE_Ctrl_M()
Application.CutCopyMode = False 'clears any existing copy mode
On Error GoTo EXITSUB 'exits if cancel clicked (NB cant use label "end")
Dim RANGE_TO_COPY As Range 'define inputbox variable
Dim CELL_TO_PASTE_TO As Range 'define inputbox variable
'-----------name SOURCE range = selected before macro started
Set RANGE_TO_COPY = Selection 'is this necessary, when not using inputbox?
COPYSOURCE = RANGE_TO_COPY.Address(False, False) 'name the inputbox selection as a range
'=========== inputbox to select PASTE destination
Set CELL_TO_PASTE_TO = Application.InputBox("select cell/range to PASTE TO, with the mouse" & vbNewLine & "CANCEL IF RANGES OVERLAP!", Default:=Selection.Address, Type:=8)
'------------- assigns name to the selected DESTINATION range
PASTERANGE = CELL_TO_PASTE_TO.Address(False, False) 'name the inputbox selection as a range
'=========== action = COPY SOURCE
Range(COPYSOURCE).Copy
'======================PASTE TO DESTINATION
'DEFAULT: PASTE FORMULAS AND NUMBER FORMATS (MATCHES DESTINATION FORMAT, keeps date/ etc original):
Range(PASTERANGE) _
.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'formulas+number format
'======DELETE SOURCE CELL CONTENTS - remove if COPY required
'??? how to select COPYSOURCE not overlapping PASTERANGE
Range(COPYSOURCE).ClearContents 'deletes contents keeps formatting
EXITSUB:
End Sub
Спасибо (я новичок, любая помощь приветствуется)
РЕДАКТИРОВАТЬ: я искал, чтобы определить новый диапазон из диапазона COPYSOURCE путем исключения пересеченной части, используя аргументы пересечения или не пересекаются, не мог понять, как.