动态选择VBA-excel

Question

我试图基本上自动化复制和粘贴工作。我想将一个文档中的数据转移到另一个文档中。我想根据单元格中的内容找到数据，这些数据并不总是在同一个地方，我想在该单元格下面选择值直到下一个空白行。

例如：选择单元格下方“CURRENT MONTH”范围内的所有单元格，直到下一行为空白。

这是我到目前为止：

Sub getCurrentMonth()

'get the current month data
Windows("File1.xlsm").Activate
Sheets("Sheet1").Select
celltxt = ActiveSheet.Range("B1:B1000").Text
If InStr(1, celltxt, "CURRENT MONTH") Then
N = Cells(7, 2).End(xlDown).Select
Range("B7:AD" & N).Select
Selection.Copy
Windows("Automation.xlsm").Activate
Sheets("Sheet1").Select
Range("A2").Select
ActiveSheet.Cells(rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial
Else
MsgBox ("No data for Current Month Found")
End If    

End Sub

Answer 1

试一试。它假定当前月份下的所有数据都是连续的，具体取决于您的描述。如果不是，请告诉我，我会编辑。

Option Explicit

Sub getCurrentMonth()

    'get the current month data
    With Workbooks("File1.xlsm").Worksheets("Sheet1")

        Dim foundIt As Range
        Set foundIt = .Range("B1:B1000").Find("CURRENT MONTH", lookat:=xlWhole)

        If Not foundIt Is Nothing Then

            Set foundIt = .Range(foundIt.Offset(1,-1), foundIt.End(xlDown)) 'from column A and down
            Set foundIt = foundIt.Resize(foundIt.Rows.Count,29) 'from column A to AD
            Workbooks("Automation.xlsm").Worksheets("Sheet1").Range("A2").Resize(foundIt.Rows.Count, foundIt.Columns.Count).Value = foundIt.Value

        Else

            MsgBox ("No data for Current Month Found")

        End If

    End With

End Sub