Question

我有一张包含4张的Excel工作簿。

主表
test_1
test_2
test_3

我想将数据从Master Sheet移动到所有其他工作表，我通过创建宏来完成。每日主表单数据将会增加，因此我如何在宏中容纳此更改。

我已粘贴以下现有代码：

Sub sbCopyRangeToAnotherSheet()
    Sheets("Master").Range("B10:M1628").Copy
    Sheets("test_1").Activate
    Range("B9").Select
    ActiveSheet.Paste
    Application.CutCopyMode = Flase
End Sub


Sub sbCopyRangeToCRP2()
    Sheets("Master").Range("B10:M1628").Copy
    Sheets("test_2").Activate
    Range("B9").Select
    ActiveSheet.Paste
    Application.CutCopyMode = Flase
End Sub


Sub sbCopyRangeToCRP3()
    Sheets("Master").Range("B10:M1628").Copy
    Sheets("test_3").Activate
    Range("B9").Select
    ActiveSheet.Paste
    Application.CutCopyMode = Flase
End Sub

在上面的代码中，我提到了Master Sheet的硬编码范围值，它从B10开始到M1628结束。

前进行数增加**（B10范围将保持不变）**并且我不想对范围进行硬编码。我怎么能做到这一点？

Answer 1

我建议使用Worksheet对象的UsedRange属性，

或定义工作表上的命名范围，随着工作表上的数据增长而自动展开，例如：=OFFSET($A$1,0,0,COUNTA($A:$A),1)

Answer 2

我建议将这三个子组合成一个可以重复使用的子组件，方法是将工作表作为参数：

Sub sbCopyRangeToAnotherSheet(ToSheet As Worksheet)
    Dim LastUsedRow As Long

    With Sheets("Master")
        LastUsedRow = .UsedRange.Row + .UsedRange.Rows.Count - 1
        .Range("B10:M" & LastUsedRow).Copy ToSheet.Range("B9")
    End With

    Application.CutCopyMode = False
End Sub

然后您可以为任何工作表名称（如

）运行此子目录

Sub test_1()
    sbCopyRangeToAnotherSheet Sheets("test_1")
    'and for the second sheet
    sbCopyRangeToAnotherSheet Sheets("test_2")
End Sub

Answer 3

您可以使用此循环宏

Sub CopyAll()
    Dim src As Range, dest
    With Worksheets("Master") ' set the source range
        Set src = .Range("B10:M" & .Cells(.Rows.Count, "B").End(xlUp).Row)
    End With
    For Each dest In Array("test_1", "test_2", "test_3") ' loop on destination sheets
        src.Copy Worksheets(dest).Range("B9")
    Next
End Sub

Answer 4

我认为复制数据的最佳方法是使用一个数字填充的数组。

创建确切的数组
填写Master Sheet
粘贴数据。

在这种情况下，您不必担心新行，因为您使用的是dinamic数组。请参阅下面的一些示例。

Sub sbCopyRangeToAnotherSheet()
Sheets("Master").Select
Dim RowNum as integer 
For i = 0 To 250000 'Count all rows
    If IsEmpty(Cells(i + 10, 2)) = False Then
        RowNum = RowNum + 1 'Count all rows which have data in it's second column
    Else
        Exit For
    End If
Next
ReDim myData(RowNum - 1, 12) As String 'create array
For i = 0 To RowNum - 1 'fill array, with data
    For j = 0 to 12
    myData(i, j) = Cells(i + 10, j+2) '+10 because you said B**10**
                                      '+2 because you said **B**10
    Next
Next

Sheets("test_1").Activate
For i = 0 To RowNum - 1 'fill array, with data
    For j = 0 to 12
    Cells(i + 10, j+2) = myData(i, j) 'Fill cells with data
    Next
Next
End Sub

使用VBA将数据从一个工作表移动到另一个工作表

4 个答案: