Question

我目前要移动的每张纸都有代码，但我想知道是否有一种方法可以减少此代码。

这是我目前用来将每张纸移动8次左右的方法：

   For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = "ONI" Then
        Set RNG1 = ONI.Range("A1:AK1").EntireColumn
        Set RNG2 = All.Range("A1:AK1").EntireColumn
        RNG2.Value = RNG1.Value
    End If
Next

这是我要将单列从所有工作表移动到单个工作表时使用的代码。我不知道如何修改它以包含更多列。

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "MainSheet" Then
        Set RNG1 = ws.Range("A1:A700")
        Set RNG2 = Sheets ("MainSheet") _ 
        .Cells(Rows.Count,"A").End(xlUp).Offset(1)
        RNG2.Value = RNG1.Value
    End If
Next

那么基本上可以修改此代码以包含多列吗？

Answer 1

为价值转移而不是复制/粘贴而致以荣誉。您只需要调整Rng2的大小即可匹配Rng1的大小。

我还修改了它以处理动态行数。如果您需要为每张纸复制一个静态范围，则可以摆脱LR位，并对该范围进行硬编码。您需要保留nLR，因为这将确定主表上的下一个可用行。

Sub Test()

Dim ms As Worksheet: Set ms = ThisWorkbook.Sheets("MainSheet")
Dim ws As Worksheet, Rng1 As Range, Rng2 As Range
Dim LR As Long, nLR As Long   '(LR = Last Row, nLR = New Last Row for Main Sheet)

For Each ws In Worksheets
    If ws.Name <> ms.Name Then

        'Determine Relavent Ranges (last rows)
        LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        nLR = ms.Range("A" & ms.Rows.Count).End(xlUp).Offset(1).Row

        'Set the ranges
        Set Rng1 = ws.Range("A1:L" & LR)
        Set Rng2 = ms.Range("A" & nLR).Resize(Rng1.Rows.Count, Rng1.Columns.Count)

        'Value Transfer
        Rng2.Value = Rng1.Value

    End If
Next ws

End Sub

Answer 2

自从我写vba很久以来，您就认为这里需要一个嵌套循环，所以我提供了伪代码，希望对您有帮助。

for each ws
dim rang as Range
for Each rnge In Range("A1:H1").Columns
do something
next
next

将多个工作表合并到同一工作簿中的单个工作表中

2 个答案: