从Activecell复制行（非CurrentRegion）直到空白

Question

我试图找到activecell并复制当前区域。但我需要复制整行。

现有代码：

Sub findRange(valueToFind)

    Dim ra As Range
    Dim xlSheet As Worksheet
    Dim DestSheet As Worksheet
    Dim lastRow As Long

    Set xlSheet = ActiveWorkbook.Worksheets("Sheet2")
    Set DestSheet = Sheets("Sheet3")

    Set ra = xlSheet.Cells.Find(What:=valueToFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    True, SearchFormat:=False)

    lastRow = DestSheet.Cells(DestSheet.Rows.Count, "B").End(xlUp).Row

    ra.CurrentRegion.Copy _
    Destination:=DestSheet.Range("A" & lastRow + 1)

End Sub

Answer 1

我不确定这是否是你想要完成的事情，但是：

• a,b 是当前单元格
• ActiveCell是您按下End Down时要去的单元格，意思是当前单元格下面的最后一个被占用单元格
• ActiveCell.End(xlDown)是
之间的范围

既然你说你想要整行你需要

Range(ActiveCell, ActiveCell.End(xlDown))

尝试

  Range(ActiveCell, ActiveCell.End(xlDown)).EntireRow

看看这是否真的是你想要的;如果是，请将 Range(ActiveCell, ActiveCell.End(xlDown)).EntireRow.Select 替换为.Select

Answer 2

CurrentRegion返回一个Range对象，该对象表示一组连续数据。只要数据被一个空行和一个空列包围。 这应该可以满足您的需求。

Sub findRange(valueToFind)

Dim ra As Range
Dim xlSheet As Worksheet
Dim DestSheet As Worksheet
Dim lastRow As Long

Set xlSheet = ActiveWorkbook.Worksheets("Sheet2")
Set DestSheet = Sheets("Sheet3")

Set ra = xlSheet.Cells.Find(What:=valueToFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False)

lastRow = DestSheet.Cells(DestSheet.Rows.Count, "B").End(xlUp).Row

StartRow = ra.CurrentRegion.Rows(1).Row 'gets the starting row of you current region
RegionRowCount = ra.CurrentRegion.Rows.Count 'counts the number of rows in your current region
    'StartRow + RegionRowCount - 1 is used to get the last row of the CurrentRegion, -1 is because we counted the first row
xlSheet.Rows(StartRow & ":" & StartRow + RegionRowCount - 1).Copy _
Destination:=DestSheet.Range("A" & lastRow + 1)
End sub

Answer 3

真的很感谢所有的帮助！从未使用过VBA。它让我有信心继续下去。非常感谢。

必须有几种方法来解决问题。我对currentregion-offset-resize感到满意。

Sub findRange(valueToFind)

Dim ra As Range
Dim xlSheet As Worksheet
Dim DestSheet As Worksheet
Dim lastRow As Long
Dim StartRow As Long, RegionRowCount As Long

Application.ScreenUpdating = False

Set xlSheet = ActiveWorkbook.Worksheets("Sheet2")
Set DestSheet = Sheets("Sheet3")

lastRow = DestSheet.Cells(DestSheet.Rows.Count, "B").End(xlUp).Row

Set ra = xlSheet.Cells.Find(What:=valueToFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False)

ra.CurrentRegion.Resize(, 100).Copy _
Destination:=DestSheet.Range("A" & lastRow + 1)

Application.ScreenUpdating = True

End Sub