Блог

Главная - Вопросы по программированию - Сбор данных с нескольких листов на одном новом листе

Сбор данных с нескольких листов на одном новом листе

#excel #vba

#excel #vba

Вопрос:

Я пытаюсь добавить данные из столбца AG1 на нескольких листах на одном новом листе.
(например: worksheet1 в столбец A, worksheet2 в столбец B и т. Д.).

 Sub Macro1()
'
' Macro1 Macro
'

'
    Sheet1.Activate
    Range("AG2:AG5000").Select
    Selection.Copy
    Sheets("Try").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    Sheets2.Activate
    Range("AG2:AG5000").Select
    Selection.Copy
    Sheets("Try").Select
    Range("B1").Select
    ActiveSheet.Paste
End Sub

Пока я просто могу использовать макрос из «записать макрос».

Проблемы заключаются в следующем:
(1) количество листов всегда разное,
(2) название каждого листа всегда разное.

Комментарии:

1. Что вы пробовали? Пожалуйста, включите код, который вы придумали до сих пор, в свой вопрос.

2. «в одну строку на новом листе» не соответствует «worksheet1 в столбец A, …». Что вы хотите «Объединить»? Строки или столбцы? Означает ли это «Объединение» копирование каждого столбца на новый лист?

3. @braX извините, забыл ввести свой код

4. @FaneDuru моя ошибка, я сожалею

5. @FaneDuru может быть, правильное слово — «собирать». Да, я пытаюсь скопировать 1 диапазон всех существующих листов на листе «Попробовать». Возможно, мне сначала нужно узнать о макросах, прежде чем задавать здесь вопрос, но я не знаю, что я хочу делать

Ответ №1:

Попробуйте использовать приведенные ниже коды.

 Sub CopyFromMultiple()
Dim sh As Worksheet
Dim pColumn As Long

pColumn = 1
    
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "Try" Then
            sh.Range("AG2:AG5000").Copy Sheets("Try").Cells(1, pColumn)
            pColumn = pColumn   1
        End If
    Next

End Sub

Ответ №2:

Попробуйте следующий способ, пожалуйста:

 Sub testCollectingColData()
 Dim sh As Worksheet, shTr As Worksheet, arr As Variant, colNo As Long
 
 Set shTr = Worksheets("Try")
 For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> shTr.Name Then
        colNo = colNo   1
        arr = sh.Range("AG2:AG5000").Value
        shTr.Range(shTr.cells(1, colNo), shTr.cells(5000 - 1, colNo)).Value = arr
    End If
 Next
End Sub