VBA复制范围直到单元格值=特定文本/值答案

【问题标题】：VBA Copy Range Until Cell Value = specific text/valueVBA复制范围直到单元格值=特定文本/值
【发布时间】：2020-10-05 20:50:22
【问题描述】：

我正在尝试编写一个宏来从一组单元格中复制数据并将其粘贴到新的工作表中。

我想停止选择 A 列中最后一个单元格等于“HOURS TOTAL”的位置，这将根据 A9 和“HOURS TOTAL”所在的最后一行/单元格之间的数据进行动态选择。我尝试了四种不同的方法，但都没有产生正确的结果。

Sub Copy_Data()
'
'Copy_Data Macro
'

'

Dim lastCell As String



Sheets("OPSEQB").Select
Range("A9", Range("P9").End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste


End Sub



Sub Copy_Data2()

Dim copyRange As String

Startrow = A9
LastRow = 11
Let copyRange = "A" & Startrow & ":" & "D" & LastRow
Range(copyRange).Select
End Sub




Sub Copy_Data3()
'
'Copy_Data Macro
'

'

Dim LastRow As String
LastRow = Range.SpecialCells(xlCellTypeLastCell, "HOURS TOTAL").Row


Sheets("OPSEQB").Select
Range("A9", Range("P9").End(xlToRight)).Select
Range(Selection, Selection.End(LastRow)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste


End Sub



Sub Copy_Data4()
'Best used when you want to include all data stored on the spreadsheet

Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set sht = Worksheets("OPSEQB")
Set StartCell = Range("A9")

'Refresh UsedRange
  Worksheets("OPSEQB").UsedRange

'Find Last Row and Column
  LastRow = StartCell.SpecialCells(xlCellTypeLastCell, "HOURS TOTAL").Row
  LastColumn = StartCell.SpecialCells(xlCellTypeLastCell).Column

'Select and copy Range
  sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
  Selection.Copy
'Add a sheet and paste the range
  Sheets.Add After:=ActiveSheet
  Range("A1").Select
  ActiveSheet.Paste


End Sub

【问题讨论】：

标签： excel vba

【解决方案1】：

我会使用Application.WorksheetFunction.Match() 在第一列搜索“HOURS TOTAL”，选择从 A9 到匹配行的所有单元格，然后选择右侧。

Public Sub Copy_Data()

    Dim lastCell As Range, wrkSht As Worksheet
    Dim lastRow As Integer, firstCol As Range
    Dim copyRng As Range
    
    Set wrkSht = ActiveWorkbook.Worksheets("OPSEQB")
    lastRow = Application.WorksheetFunction.Match("HOURS TOTAL", wrkSht.Range("A:A"))
    Set firstCol = wrkSht.Range(wrkSht.Range("A9"), wrkSht.Cells(lastRow, 1))
    Set copyRng = wrkSht.Range(firstCol, firstCol.End(xlToRight))

    copyRng.Copy
    Sheets.Add After:=ActiveSheet
    Range("A1").Select
    ActiveSheet.Paste

End Sub

【讨论】：

尽管我更喜欢我的回答，但我会给你一个赞成票，因为这不是一个糟糕的第一个答案。一些友好的提示： 1. 不要使用 select ? (stackoverflow.com/questions/10714251/…) 2. 无需复制所有列。正如 OP 试图做的那样，最好将范围限定为 usedrange。
@PGSystemTester - 谢谢。 1）我通常也不使用 select ，但我在“我的方式”做它和在某种程度上保留 OP 的代码之间左右为难。 2) 我认为我没有选择所有列（即“A:XFD”）。 Range.End() 仅扩展到包含数据的最后一个单元格。不过，我不知道 UsedRange。这可能会派上用场。
哦对不起...忘记投票了！ .usedRange 是您在 VBA Excel 历险记中继续前进时必须知道的……祝您好运！

【解决方案2】：

有很多方法可以做到这一点。我认为，如果您使查找范围成为其自己的功能，则代码会变得更加清晰（对我而言）。这应该可以工作，并且可以在this file here 中进行测试。

Sub Copy_Data()

Sheets.Add After:=ActiveSheet
findStuff.Copy Range("A1")

End Sub


Private Function findStuff() As Range
    Const starCellAddress As String = "A9"
    Const targetText As String = "HOURS TOTAL"
    Const sName As String = "OPSEQB"

    Dim WS As Worksheet
        Set WS = Sheets(sName)
    
    For Each acell In Intersect(WS.Range(starCellAddress).EntireColumn, WS.UsedRange).Cells
        If UCase(acell.Value) = UCase(targetText) Then
            Exit For
        End If
    Next acell
    
    
    'if you want all columns in this range
        Set findStuff = Intersect(Range(WS.Range(starCellAddress), acell).EntireRow, WS.UsedRange)
    
    'if you just want column A
       ' Set findStuff = Range(ws.Range(starCellAddress), acell)

End Function

【讨论】：