新工作簿中從范圍到相應范圍的數據

Question

我需要一個代碼來查看工作簿（“主”）中每個工作表的每一列，將數據復制到新工作表（“ 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

我的問題是，這變成了很長，很笨拙的代碼。 我需要對幾個標題（“ Lanuages”，“ ID Num”，“ Territory”等）重復相同的過程，並且我正在尋找一種使用動態范圍和變量而不是命名范圍的方法。

我是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

希望這會給您一些關於如何在循環中使用動態范圍的想法。