Copying values, applying a formula and pasting the results as values. All operations in different Sheets - VBA Macro Excel

I am trying to create a Macro in Excel with VBA, that builds a bunch of different email addresses with a person's first, middle and last name and the company's email domain. I then want to verify these different email addresses with an email bulk tester which is another application.

In Sheet1 I have the input data for the email addresses in the following columns:

First names: F

Middle names: G

Last names: H

Email domains: I

Since there are 52 different persons whose email addresses I want to find, all the data is thus in cells F2:I53.

On Sheet2 I would need to fill in the first, middle and last name as well as the email domain of each person separately in cells B2:B5. On the same Sheet, 46 different possible email addresses will be generated for each person in cells G2:G47.

On Sheet3, I want to copy paste all 46 different email addresses as values. For the first person, I want to copy paste these 46 email addresses into cell A3. For the second person I want to copy paste them into cell A49, for the third person into cell A95, etc. Since I wanna do this for 52 persons, the last populated cell should be A2394.

Here you can take a look at this table which I would normally have in excel:

https://docs.google.com/spreadsheets/d/1kWPfscdnz_TCS7K1H3to1rBgRzJ9XSBH8L7rjKhlTnc/edit?usp=sharing

Thus the macro is supposed to do the following in the first iteration:

1. Select and copy cells F2:I2 on Sheet1




2. Go to Sheet2 and special paste them (transpose) in cells B2:B5





3. Select and copy cells G2:G47




4. Go to Sheet3 and past them as values into cell A3

In the second iteration, the macro is supposed to do the following:

1. Select and copy cells F3:I3 on Sheet1




2. Go to Sheet2 and special paste them (transpose) in cells B2:B5




3. Select and copy cells G2:G47





4. Go to Sheet3 and past them as values into cell A49

As you can see in 1) and 2), the row number increments after every iteration. This whole process is thus to be repeated 52 times. Below, you can see the macro I have created

Sub Macro1()
Dim i As Integer
Dim m As Integer
For i = 1 To 52
    'selecting the first, middle and last name (columns I to F)

    m = i + 1
    Range("F" & m & ":I" & m).Select ' maybe I need to use the Indirect function here?
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ' Maybe give excel some time to calculate the email addresses first?
    Application.Calculate
    Range("G2:G47").Select

    Selection.Copy
    Sheets("Sheet3").Select
    'Find the first empty cell in column A
    Range("A1").End(xlDown).Offset(1, 0).Select
    'pasting the email addresses as values
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'end of iteration
Next i
End Sub

However, when I run the macro, the cells A3:A2394 on Sheet3 only contain the @ sign (see google sheet). Unfortunately, I have no idea where exactly the error occurs. My suspicion was that I need to give excel some time to calculate the 46 different email addresses in G2:G47 in Sheet2, so I added the "Application.Calcuate" command, but it also didn't work.

Would be awesome if someone of you could help.

Thanks in advance,
Kevin

Answer

Below code is now working:

Sub Macro1()

Dim i As Integer
Dim m As Integer

Dim wSheet1 As Worksheet
Dim wSheet2 As Worksheet
Dim wSheet3 As Worksheet


Set wSheet1 = Sheets("Sheet1")
Set wSheet2 = Sheets("Sheet2")
Set wSheet3 = Sheets("Sheet3")

For i = 1 To 52
    'selecting the first, middle and last name (columns I to F)
    m = i + 1
    wSheet1.Range("F" & m & ":I" & m).Copy
    wSheet2.Range("B2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

    ' Maybe give excel some time to calculate the email addresses first?
    Application.Calculate
    wSheet2.Range("G2:G47").Copy
    'Find the first empty cell in column A and paste as values
    wSheet3.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'end of iteration
Next i

    ' code from the macro runner

    'Range("F2:I2").Select ' question is how to select the same range next time, only one row lower?
    'Selection.Copy
    'Sheets("Sheet2").Select
    ' pasting the name (as transpose)
    'Range("B2").Select
    'Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ' selecting all the possible email addresses
    'Range("G2").Select ' shouldn't it be Range("G2:G47).Select ?
    'Range(Selection, Selection.End(xlDown)).Select

    'Application.CutCopyMode = False
    'Selection.Copy
    ' paste all possible email addresses as values into Sheet3
    'Sheets("Sheet3").Select
    'Range("A1").Select ' Question is how to select the first empty row in column A of that Sheet
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End Sub