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

您可以在首次设置 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

Answer 2

作为 follow-up 我的评论：

The "easy" way is to add a header of some sort in B9. If that's not an option, then you could always check the .Row of NextFreeCell and if it's less than 10 use B10 instead.

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

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 将始终在下方。

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

Excel VBA - Copy and paste row to a new blank row, starting in predefined location

excel

vba

paste