新工作簿中从范围到对应范围的数据

Question

我需要一个代码来查看工作簿（“Master”）中每个工作表的每一列，将数据复制到新工作表（“Sheet1”），并为每个数据点创建四个条目。我需要将数据复制到新工作表中的某些列；例如，我需要将 Sheets("Australia") 的 T 列中的数据复制到 Sheets("Sheeet1") 中的 S 列，将 V 列复制到 U 列等。

最终结果应如下所示：

Workbooks("Master").Sheets("Australia")
Column T  Column V
1         4
2         5
3         6

变成……

Workbooks("NewWB").Sheets("Sheet1")
Column S Column U
1        4
1        4  
1        4
1        4
2        5
2        5
2        5
2        5
...      ...

我已经试过了：

Sub Populate()

Dim WS As Worksheet
Dim ShtNames(1 To 75) As String
Dim y As Integer

On Error Resume Next

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks.Add
With ActiveWorkbook.Sheets("Sheet1")

    .Range("B1").Value = "Language"

End With

y = 1
For Each WS In Workbooks("Master").Worksheets
ShtNames(y) = WS.Name
y = y + 1
Next WS

'Languages
    ActiveWorkbook.Sheets("Sheet1").Range("B2").Activate
    For y = LBound(ShtNames) To UBound(ShtNames)
    For Each Cell In Workbooks("Master").Sheets(ShtNames(y)).Range("AT6:AT160")
    If Cell.Value <> "" Then
                For Rownum = 1 To 4
                    ActiveCell.Value = Cell.Value
                    ActiveCell.Offset(1, 0).Select
                Next Rownum
    End If
    Next Cell
    Next y

Application.ScreenUpdating = True
Application.Displayalerts = True

End Sub

我的问题是这变成了一个很长、很笨重的代码。我需要对几个标题（“语言”、“ID Num”、“领土”等）重复相同的过程，并且我正在寻找一种使用动态范围和变量而不是命名范围的方法。

我是 VBA 初学者；您的专家为我提供的任何东西都将不胜感激！非常感谢！

Answer 1

希望这将为您指明正确的方向。下面的代码是在同一个工作簿中从一个工作表复制到另一个工作表，但您可以修改以复制到另一个工作簿：

    Dim src As Range
    Dim Col1, Col2
    Dim DestRow As Integer

    Set src = ActiveWorkbook.Sheets("Master").Cells(1, 20).CurrentRegion
    DestRow = 1    ' the destination starting row
    For SourceRow = 1 To srcRow.Rows.Count
        Col1 = ActiveSheet.Cells(SourceRow, 20)   ' column T
        Col2 = ActiveSheet.Cells(SourceRow, 22)   ' column V

        ' copy to destination sheet 4 times
        For x = 1 To 4
            Sheets("Sheet2").Cells(DestRow, 19) = Col1  ' column S
            Sheets("Sheet2").Cells(DestRow, 21) = Col2  ' column U
            DestRow = DestRow + 1
        Next
    Next

希望这能给您一些关于如何在循环中使用动态范围的想法。