復制值，應用公式並將結果粘貼為值。 不同工作表中的所有操作-VBA Macro Excel

Question

我正在嘗試使用VBA在Excel中創建一個宏，該宏使用一個人的名字，中間名和姓氏以及公司的電子郵件域來構建一堆不同的電子郵件地址。 然后，我想使用另一個應用程序電子郵件批量測試器來驗證這些不同的電子郵件地址。

在Sheet1中，以下各欄中提供了電子郵件地址的輸入數據：

名：F

中間名：G

姓：H

電子郵件域：我

由於我要查找52個不同的電子郵件地址，因此所有數據都在單元格F2：I53中。

在Sheet2上，我需要在單元格B2：B5中分別填寫每個人的名字，中間名和姓氏以及電子郵件域。 在同一工作表上，將在單元格G2：G47中為每個人生成46個不同的可能電子郵件地址。

在Sheet3上，我要復制粘貼所有46個不同的電子郵件地址作為值。 對於第一人稱，我想將這46個電子郵件地址復制粘貼到單元格A3中。 對於第二個人，我要復制粘貼到單元格A49中，對於第三個人將其粘貼到單元格A95中，依此類推。由於我想對52個人進行復制，因此最后一個填充的單元格應該是A2394。

在這里，您可以看一下我通常在excel中擁有的這張表：

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

因此，該宏應該在第一次迭代中執行以下操作：

1. 選擇並復制Sheet1上的單元格F2：I2

2. 轉到Sheet2並將其特殊粘貼（轉置）到單元格B2：B5中

3. 選擇並復制單元格G2：G47

4. 轉到Sheet3並將其作為值粘貼到單元格A3中

在第二次迭代中，該宏應該執行以下操作：

1. 選擇並復制Sheet1上的單元格F 3 ：I 3

2. 轉到Sheet2並將其特殊粘貼（轉置）到單元格B2：B5中

3. 選擇並復制單元格G2：G47

4. 轉到Sheet3並將其作為值粘貼到單元格A 49中

如您在1）和2）中所見，行號在每次迭代后都會遞增。 因此，整個過程將重復52次。 在下面，您可以看到我創建的宏

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

但是，當我運行宏時，Sheet3上的單元格A3：A2394僅包含@符號（請參閱Google工作表）。 不幸的是，我不知道確切的錯誤發生在哪里。 我的懷疑是，我需要給excel一些時間來計算Sheet2中G2：G47中46個不同的電子郵件地址，因此我添加了“ Application.Calcuate”命令，但是它也沒有用。

如果你們中的某人可以提供幫助，那將會很棒。

預先感謝，凱文

Answer 1

我不能發表評論，所以我必須把它當作答案。

我想的問題是您的代碼並不特定於選擇range 。 為了改善您的代碼，您可能需要嘗試：

dim wSheet1 as Workbook
dim wSheet2 as Workbook
dim wSheet3 as workbook

set wSheet1 = Workbooks("Sheet1")
set wSheet2 = Workbooks("Sheet2")
set wSheet3 = Workbooks("Sheet3")

然后使用：

wSheet1.Range(....)

來指定您要引用的工作表，而不是.select 。

Answer 2

下面的代碼現在可以正常工作：

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