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

问题描述

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,Transpose:=False
'delete text box
ThisWorkbook.Save
Application.Goto Reference:="R2C4"
Application.CutCopyMode = False
Selection.ClearContents

源范围B2：D2是数据输入框（日期/时间/自由文本）。

当粘贴到下一个自由行时，当前它直接粘贴在原始数据输入框的下面，因此在B3中，然后在B4中，等等。

我如何让它从较低的地方开始，例如B10？

解决方法

您可以在首次设置IF之后立即添加一个NextFreeCell语句，它看起来像（假设您希望结果从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,Transpose:=False
'delete text box
ThisWorkbook.Save
Application.Goto Reference:="R2C4"
Application.CutCopyMode = False
Selection.ClearContents

,

作为对我的评论的后续行动：

“简便”的方法是在B9中添加某种标题。如果不是这种选择，那么您始终可以检查.Row中的NextFreeCell，如果小于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始终位于下方。