excel vba - 特定的复制/粘贴字符串到另一个工作表，其所有范围到另一个工作表中的特定范围

Question

我完全是 Excel VBA 的新手！
当找到某个字符串时，我的任务是将范围从工作表“Job”复制到工作表“Einfügen”。
我之前所做的是手动选择然后将其从“Job”复制粘贴到“Einfügen”。我想使用 VBA 从“Job”中的 19 个可用范围中选择和复制 6 个范围（每个范围有固定数量的行，即 1600，列可以是 4 或 6），我将搜索每个表标题在“作业”表的 A 列中使用 Find 方法，然后使用 Find 的结果加上偏移量作为动态范围的起始位置。

例如，字符串“Av”在 A8033 中找到，但我需要的范围从 C8035 开始。而且这些字符串的位置在特定行中也不是固定的，它们可以针对不同的输入进行不同的排序。
因此，在这种情况下，我想首先在“Job”中找到“Av”位置，在此示例中为 A8033，它有 4 行，然后选择范围 C8035 到 F9635{F(8035+1600)} 并将其复制粘贴到“Einfügen”中的固定范围是 C11:F1611。
然后重复所有其他 6 个标题字符串。标题将全部出现在 A 列中，所有表格与搜索字符串结果的偏移量相同 (2,2)，列数相同（4 或 6），行数相同（1600）。 我尝试了很多方法来解决它，但不幸的是我找不到代码。 如果你能帮我解决这个问题，我真的很感激。 我的 6 个字符串是：“Av”、“An”、“Af”、“Zi”、“Ar”、“LCL” 我在 Job 中的表是这样的：

        A    B            C           D           E           F
8033    Av                                  
8034   Idx  [Hz]         DA 1        DA 2        DA 3        DA 4
8035    0   1,00E+06    -9,58E-01   -9,65E-01   -9,74E-01   -9,62E-01
8036    1   2,87E+06    -1,49E+00   -1,51E+00   -1,52E+00   -1,50E+00
8034    2   4,75E+06    -1,84E+00   -1,88E+00   -1,88E+00   -1,86E+00
8035    3   6,62E+06    -2,14E+00   -2,19E+00   -2,17E+00   -2,15E+00
8036    4   8,50E+06    -2,39E+00   -2,45E+00   -2,43E+00   -2,41E+00
8037    5   1,04E+07    -2,63E+00   -2,70E+00   -2,66E+00   -2,65E+00
8038    6   1,22E+07    -2,86E+00   -2,92E+00   -2,89E+00   -2,88E+00
8039    7   1,41E+07    -3,07E+00   -3,14E+00   -3,10E+00   -3,09E+00
.
.
9635   1600 3,00E+09    -6,07E+01   -5,51E+01   -8,11E+01   -4,92E+01

你可以在这里看到我的代码：

Sub DoMyJob()

    Dim IDump As Worksheet
    Dim f As Range
    Dim g As Range
    Dim CapPremRng As Range
    Worksheets("Job").Activate
    Set IDump = Sheets("Job")

    Set f = IDump.Range("A1:A30488").Find(What:="Av", LookIn:=xlValues, LookAt:=xlPart)
    Set g = f.Offset(2, 2).Activate

    Set CapPremRng = g.Range("A1:I" & Lastrow)

    CapPremRng.Copy
    Sheets("Einfügen").Range("C11" & Lastrow).PasteSpecial xlValues

End Sub

Answer 1

试试这个（注释的）代码：

Option Explicit

Sub DoMyJob()
    Dim f As Range
    Dim lastRow As Long
    Dim keyword As Variant

    Const KEYWORDS As String = "Av,An,Af,Zi,Ar,LCL" '<--| list your 'keyword' strings
    Const DATASETROWS As Long = 1600 '<--| define data set range fixed amount of rows
    Const DATASETCOLUMNS As Long = 6 '<--| define data set range maximum amount of columns
    Const COLUMNSOFFSETFROMKEYWORD As Long = 2 '<--| define data set range rows offset from keyword cell
    Const ROWSOFFSETFROMKEYWORD As Long = 2 '<--| define data set columns rows offset from keyword cell

    With Worksheets("Job") '<--| reference your data worksheet
        With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) '<--! reference its column "A" cells form row 1 down to last non empty one
            For Each keyword In Split(KEYWORDS, ",") 'loop through 'keywords' list
                Set f = .Find(What:=keyword, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) '<--| search referenced cells for current 'keyword'
                If Not f Is Nothing Then '<--| if 'keyword' found then...
                    Sheets("Einfügen").Range("C11").Offset(lastRow).Resize(DATASETROWS, DATASETCOLUMNS).Value = _
                    f.Offset(ROWSOFFSETFROMKEYWORD, COLUMNSOFFSETFROMKEYWORD).Resize(DATASETROWS, DATASETCOLUMNS).Value '<--| copy data set fixed range values
                    lastRow = lastRow + DATASETROWS '<--|update destination sheet pasting row
                End If
            Next keyword
        End With
    End With
End Sub