Объединить несколько листов в один лист в одной книге

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