Question

我需要一个代码，用于查看工作簿中每个工作表的每一列（＆＃34; Master＆＃34;），将数据复制到新工作表（＆＃34; Sheet1＆＃34;），并为每个数据点创建四个条目。我需要将数据复制到新工作表中的某些列;例如，我需要Sheets（＆＃34; Australia＆＃34;）的第T列中的数据复制到Sheets（＆＃34; Sheeet1＆＃34;），第V列到第U列等的列S中。

最终结果如下：

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

我的问题是，这会成为一个非常冗长，笨重的代码。我需要为几个标题重复这个过程（＃34; Lanuages，＆＃34;＆＃34; ID Num＆＃34;，＆＃34; Territory＆＃34;等等）我正在寻找一种方法使用动态范围和变量而不是命名范围。

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

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

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

1 个答案: