VBA excel - объединить столбец из нескольких листов в один столбец на другом листе

Question

Мне нужно скопировать все текстовые значения из столбца F на +10 листов и поместить их в один столбец на сводном листе.Мне не нужно выполнять какие-либо вычисления для данных, просто скопируйте текстовые значения, полученные из формул.Например:

Sheet1 Col F:

1

2

3

Sheet2 Col F:

4

5

6

Мне бы хотелось, чтобы "Master" Col A был:

1

2

3

...

6

Этот код в основном приводит меня туда, но мне нужно, чтобы Range варьировался.Например, не на каждом листе есть 3 строки данных, но я хочу, чтобы они копировались непосредственно друг за другом.

Sub MM1()
Dim ws As Worksheet, lr As Long
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each ws In Worksheets
    If ws.Name <> "Master" Then
        ws.Range("F1:G15").Copy 
        Sheets("Master").Range("A" & lr).PasteSpecial xlPasteValues
        lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End If
Next ws
End Sub

РЕДАКТИРОВАТЬ: Каждый лист имеет одинаковое количество строкс формулой в них, но значения варьируются от листа к листу.Поэтому мне нужна проверка, которая ищет значение "" в качестве "последней строки" и затем переходит на следующий лист.

Answer 1

только небольшие изменения и хорошо работает :)1. Я изменил Master на Sheet5 =>, вы можете использовать свое имя листа.2. Добавлена ​​ новая переменная в цикле для определения диапазона для каждого копируемого листа .3. Измените метод , чтобы вставить скопированные данные в место назначения.

Sub MM1()
Dim ws As Worksheet, lr As Long
lr = Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each ws In Worksheets
    If ws.Name <> "Sheet5" Then
        Dim currentRange As Long
        currentRange = ws.Cells(Rows.Count, "A").End(xlUp).Row
        ws.Range("A1:A" & currentRange).Copy Destination:=Sheets("Sheet5").Range("A" & lr)
        lr = Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End If
Next ws
End Sub

дайте мне знать, если это работает для вас или нет?

Answer 2

Прежде всего, вы можете использовать ту же логику, чтобы получить последнюю строку в столбце «F» в каждой таблице данных вместо жесткого кодирования 3 строк с использованием метода range.end(xlUp).Row.

2nd I don 'Мне нравится метод копирования-вставки.это медленно и очень мешает, вы всегда рассчитываете новую точку вставки и вставки.Вы можете использовать массив в VBA для реализации этой функциональности.А работать с массивом очень просто и быстро.

Ниже приведен код, который вы можете взять и использовать.

Sub MM1()
Application.ScreenUpdating = False
'Loop through worksheets, put the values in column F into arr array
Dim arr(1 To 10000), cnt As Integer, i As Integer
cnt = 0
For Each ws In Worksheets
    If ws.Name <> "Master" Then
        For i = 1 To ws.Cells(Rows.Count, "F").End(xlUp).Row
            cnt = cnt + 1
            arr(cnt) = ws.Cells(i, "F").Value
        Next i
    End If
Next ws

'Loop through arr array, populate value into Master sheet, column A
For i = 1 To cnt
    ThisWorkbook.Sheets("Master").Cells(i, "A") = arr(i)
Next i

Application.ScreenUpdating = True
End Sub

Answer 3

Я пытался сохранить твой код как можно лучше.Вот один из способов заставить его работать (с максимально возможной сохранностью вашего кода).Все еще есть небольшие «подправки», которые вам нужно сделать (например, ваш «Мастер» лист будет иметь пустую строку).

Sub MM1()
Dim ws As Worksheet
For Each ws In Worksheets
     If ws.Name <> "Master" Then
         ws.Range(ws.Range("F1"), ws.Range("F1").End(xlDown)).Copy
         Sheets("Master").Range("A65535").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
     End If
Next ws
End Sub