vba 将值粘贴到用户选择的一系列单元格中，有时单元格之间会出现空白
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12625506/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Paste value to a range of cells the user has selected, sometimes blanks in between cells
提问by user1703890
I want to run a macro that copies a date in multiple selected cells, sometimes they are a range but other times individual cells maybe selected. All cells will be in the same column. I recorded a macro that does this but copies in the same range or cells every time. I want it to copy into the cells I select - which will be different every time.
我想运行一个宏来复制多个选定单元格中的日期，有时它们是一个范围，但有时可能会选择单个单元格。所有单元格都将位于同一列中。我录制了一个执行此操作的宏，但每次都在相同的范围或单元格中复制。我希望它复制到我选择的单元格中 - 每次都会不同。
Here is the code
这是代码
Macro1 Macro
' Test copy range
'
' Keyboard Shortcut: Ctrl+e
'
Range("$AD").Select
Selection.Copy
Range("C10").Select
ActiveWindow.SmallScroll Down:=7
Range("C10,C12,C16:C21").Select
Range("C16").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
回答by Siddharth Rout
I hardly recommend this but if you want to paste it in the current selection then try this
我几乎不推荐这个，但如果你想把它粘贴到当前选择中，那么试试这个
Option Explicit
Sub Sample()
With Sheets("Sheet1")
.Range("$AD").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
End Sub
If you use the above method then ensure that you do proper error handling.
如果您使用上述方法，请确保您进行了正确的错误处理。
Alternatively use an InputBox()to select your range and paste it in that. See this example
或者使用InputBox()选择您的范围并将其粘贴到该范围内。看这个例子
Option Explicit
Sub Sample()
Dim Ret As Range
With Sheets("Sheet1")
On Error Resume Next
Set Ret = Application.InputBox(Prompt:="Please select a range where you want to paste", Type:=8)
On Error GoTo 0
If Not Ret Is Nothing Then
.Range("$AD").Copy
Ret.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
End With
End Sub
SCREENSHOT
截屏
