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

Question

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

例如，字符串“Av”在A8033中找到，但是我需要的范围从C8035开始。而且这些字符串的位置并不是固定在特定的行中，它们可以根据不同的输入进行不同的排序。
因此，在这种情况下，我想首先在“作业”中找到“Av”位置，在本例中它是A8033，它有4行，然后选择范围C8035至F9635 {F（8035 + 1600）}并复制粘贴它在“Einfügen”的固定范围内，即C11：F1611。
然后重复所有其他6个标题字符串。标题将全部出现在列A中，所有表将具有与搜索字符串结果（2,2）相同的偏移量和相同的列数（4或6）以及相同的行数（1600）。 我尝试了很多方法来解决它，但不幸的是我找不到代码。 我真的很感谢你能帮我解决这个问题。 我6个字符串是：“AV”，”安”，” AF”，”荀子”，” AR”，” LCL” 我的工作表是这样的：

 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