Консолидация таблиц из нескольких рабочих листов - PullRequest
0 голосов
/ 18 марта 2019
Option Explicit

Sub Macro70()

Dim wb As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim sheets_Count As Integer
Dim sheets_Name() As String
Dim i As Integer
sheets_Count = Sheets.Count

ReDim sheets_Name(0 To sheets_Count - 1)

For i = 1 To sheets_Count
   sheets_Name(i - 1) = "'" & ActiveWorkbook.Sheets(i).Name & "'!R1C1:R17C2"
Next i

Set wb = ThisWorkbook
Set ws2 = wb.Sheets.Add()

With ws2
    .Range("A1").Consolidate sheets_Name, xlSum, True, True, False
End With

End Sub


Sub Macro71()

Dim wb As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim sheets_Count As Integer
Dim sheets_Name() As String
Dim i As Integer
sheets_Count = Sheets.Count

ReDim sheets_Name(0 To sheets_Count - 1)

For i = 1 To sheets_Count
   sheets_Name(i - 1) = "'" & ActiveWorkbook.Sheets(i).Name & "'!R24C1:R35C2"
Next i

Set wb = ThisWorkbook
Set ws2 = wb.Sheets.Add()

With ws2
    .Range("A24").Consolidate sheets_Name, xlSum, True, True, False
End With

End Sub


Sub Macro72()

Dim wb As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim sheets_Count As Integer
Dim sheets_Name() As String
Dim i As Integer
sheets_Count = Sheets.Count

ReDim sheets_Name(0 To sheets_Count - 1)

For i = 1 To sheets_Count
   sheets_Name(i - 1) = "'" & ActiveWorkbook.Sheets(i).Name & "'!R39C1:R50C2"
Next i

Set wb = ThisWorkbook
Set ws2 = wb.Sheets.Add()

With ws2
    .Range("A39").Consolidate sheets_Name, xlSum, True, True, False
End With

End Sub

это прекрасно работает для меня, но последний вопрос, который я должен сказать, это то, что он генерирует новый лист.Могу ли я иметь один и тот же лист для данных, которые будут собраны для всех этих таблиц.я попытался поставить ws2.Name = "объединенный" для всех трех, но он показывает ошибку.Я хочу, чтобы сабвуферы 71 и 72 были помещены на тот же лист, что и сабвуферы 70, и огромное спасибо за помощь мне.

1 Ответ

0 голосов
/ 18 марта 2019

Я думаю, вам нужно что-то еще подобное (не проверено)

sheets_Count = Sheets.Count

ReDim sheets_Name(0 to sheets_Count-1)

For i = 1 To sheets_Count
   sheets_Name(i-1) = "'" & ActiveWorkbook.Sheets(i).Name & "'!R10C1:R26C2"
Next i

Set wb = ThisWorkbook 
Set ws2 = wb.Sheets.Add()

With ws2
    .Range("A1").Consolidate sheets_Name, xlSum, True, True, False
End With

См:

https://docs.microsoft.com/en-us/office/vba/api/excel.range.consolidate

Вот пример по этой ссылке:

Worksheets("Sheet1").Range("A1").Consolidate _ 
            Sources:=Array("Sheet2!R1C1:R37C6", "Sheet3!R1C1:R37C6"), _ 
            Function:=xlSum

РЕДАКТИРОВАТЬ - если вы хотите добавить несколько диапазонов с каждого листа, вы можете попробовать это:

Dim n
sheets_Count = Sheets.Count

ReDim sheets_Name(0 To (sheets_Count * 2) - 1)
n = 0
For i = 1 To sheets_Count
   sheets_Name(n) = "'" & ActiveWorkbook.Sheets(i).Name & "'!R10C1:R26C2" 
   sheets_Name(n+1) = "'" & ActiveWorkbook.Sheets(i).Name & "'!R40C1:R50C2"
   n = n + 2
Next i
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...