excel vba - specific copy/paste string to another sheet with all its range to specific range in another worksheet

Question

I am completely a newbie in the Excel VBA!
I have a task to copy ranges from worksheet ”Job” to worksheet ”Einfügen” when certain string is found.
What I have been previously done is manually selecting and then copy-paste it from ”Job” to ”Einfügen”. I want to use VBA to select and copy the 6 ranges out of available 19 ranges in “Job” (each range has fixed amount of rows which is 1600, columns can be 4 or 6), I am going to search for each table heading in Column A in the ”Job” sheet using the Find method, and then use the result of Find, plus an offset, as the starting position of a dynamic range.

So for example, the string "Av" is found in A8033, but the range which I need starts in C8035. And also the positions of these strings are not fixed in specific rows they can be sorted differently for different inputs.
Therefore, In this case I want to first find “Av” position in “Job” which is A8033 in this example it has got 4 rows and then select range C8035 till F9635{F(8035+1600)} and copy-paste it in fixed range in “Einfügen” which is C11:F1611 .
And then repeat for all further 6 heading strings. The headings will all appear in Column A, all the tables will have the same offset from the search string result (2,2), and the same number of columns (4 or 6), and the same number of rows (1600). I tried lots of way to solve it but unfortunately I could not find the code. I really appreciate if you could help me to solve it. My 6 strings are: “Av”,”An”,”Af”,”Zi”,”Ar”,”LCL” my table in Job is like:

        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

you can see my code here:

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

try this (commented) code:

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