Excel VBA-从预定义位置开始，将行复制并粘贴到新的空白行

Question

VBA新手，尝试在实践中学习。我有以下代码，总的来说，它正在做我想做的事情：

'define source range
Dim SourceRange As Range
Set SourceRange = ThisWorkbook.Worksheets("Log").Range("B2:D2")
'find next free cell in destination sheet
Dim NextFreeCell As Range
Set NextFreeCell = ThisWorkbook.Worksheets("Log").Cells(Rows.Count, "B").End(xlUp).Offset(RowOffset:=1)    
'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:="R2C4"
Application.CutCopyMode = False
Selection.ClearContents

源范围B2:D2是数据输入框(DATE/TIME/FREETEXT(。

当它粘贴到下一个空闲行时，它当前直接粘贴在原始数据输入框下方，因此在B3、B4等中。

我该如何让它从更低的地方开始，比如B10？

Answer 1

作为我的评论的后续：

；"容易"；方法是在CCD_ 1中添加某种类型的头。如果这不是一个选项，那么您可以始终检查NextFreeCell的.Row，如果它小于10，则使用B10。

你可能会做类似的事情，改变：

Set NextFreeCell = ThisWorkbook.Worksheets("Log").Cells(Rows.Count, "B").End(xlUp).Offset(RowOffset:=1) 

至

With ThisWorkbook.Worksheets("Log")
If IsEmpty(.Range("B10").Value) Then
Set NextFreeCell = .Range("B10")
Else
Set NextFreeCell = .Cells(.Rows.Count, "B").End(xlUp).Offset(1)
End If
End With

这将确保如果B10为空则首先填充它。在随后的运行中，NextFreeCell将始终位于下方。

Answer 2

您可以在第一次设置NextFreeCell之后立即添加一个IF语句，它看起来像(假设您希望结果从B列开始(。。。

'define source range
Dim SourceRange As Range
Set SourceRange = ThisWorkbook.Worksheets("Log").Range("B2:D2")
'find next free cell in destination sheet
Dim NextFreeCell As Range
Set NextFreeCell = ThisWorkbook.Worksheets("Log").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
If NextFreeCell.Row < 10 Then
Set NextFreeCell = NextFreeCell.Offset(10 - NextFreeCell.Row, 0)
End If
'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:="R2C4"
Application.CutCopyMode = False
Selection.ClearContents