Question

我对宏很天真。我想在具有特定值的两个单元格之间复制A列中的范围。如下所示，我想复制USA和amp;之间的所有数据。 JAPAN（排除BLANK DATA）并粘贴到特定列中的另一个工作簿中。感谢您的帮助。

Column A
==============
0
1

USA
2
13
45
52
46
57
88


11
13

JAPAN
25
27
55

我尝试了下面的CODE，但在Consultant3.Select

行中出现了一些错误

Sub SelectMyRange()

Dim Consultant1 As Integer, Consultant2 As Integer
Dim Consultant3 As Range
Dim rngFind As Range    

Set rngFind = Columns("A:A").Find(What:="OBJ NO.", After:=Range("A1"), 
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, 
SearchDirection:=xlNext)

If Not rngFind Is Nothing Then
  Consultant1 = rngFind.Row + 2
End If

Set rngFind = Columns("A:A").Find(What:="OBJ END", After:=Range("A1"), 
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, 
SearchDirection:=xlNext)

If Not rngFind Is Nothing Then
  Consultant2 = rngFind.Row - 1
End If

If Consultant1 > 0 And Consultant2 > 0 Then
  Set Consultant3 = Range(Cells(Consultant1, 1), Cells(Consultant2, 1))
End If

Consultant3.Select
Selection.Copy

End Sub

Answer 1

尝试下面的代码，代码中的解释为注释：

Option Explicit

Sub SelectMyRange()

Dim Consultant1 As Range, Consultant2 As Range
Dim Consultant3 As Range

' set the Range Cell directly
Set Consultant1 = FindRange(Columns("A:A"), "USA")

' set the Range Cell directly
Set Consultant2 = FindRange(Columns("A:A"), "JAPAN")

If Not Consultant1 Is Nothing And Not Consultant2 Is Nothing Then
    ' just use Offset on Cell's (set as range), and set it to only cells with values inside
    Set Consultant3 = Range(Consultant1.Offset(1, 0), Consultant2.Offset(-1, 0)).SpecialCells(xlCellTypeConstants)
End If
' copy the Range (there's no need to select it first)
Consultant3.Copy

' Paste to "Sheet3" Range "A2" < -- you can modify to your destination
Worksheets("Sheet3").Range("A2").PasteSpecial Paste:=xlPasteAll

End Sub

'======================================================================

Function FindRange(Rng As Range, FindStr As String) As Range

Set FindRange = Rng.Find(What:=FindStr, After:=Range("A1"), LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)

End Function

复制A列中两个单元格值之间的范围

1 个答案: