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