Попробуйте это:
Прежде всего, вам нужен список со всеми листами. Для этого используйте эту функцию:
Public Function SheetsName()
Dim Arr() As String
Dim i As Integer
ReDim Arr(Sheets.Count - 1)
For i = 0 To Sheets.Count - 1
Arr(i) = Sheets(i + 1).Name
Next i
SheetsName = Application.WorksheetFunction.Transpose(Arr)
End Function
Эта функция вернет массив со всеми листами. Выберите то же количество листов в ячейках в одном столбце, которое не используется, и введите: = SheetsName () и нажмите Ctrl + Shift + Enter. Вы получите список ваших DataSheets на этот диапазон.
Позже, используйте Data Validation
в вашей ячейке D2
, выберите список и выберите диапазон со всеми листами.
Затемиспользуйте эту небольшую процедуру, чтобы скопировать:
Sub Test()
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim i As Long
With ThisWorkbook
Worksheets("Sheet1").Activate
Set SourceSheet = Worksheets(Range("D2").Value2)
Set TargetSheet = Worksheets("Sheet1")
End With
LastRow = SourceSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
LastCol = SourceSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
For i = 1 To LastRow
For j = 1 To LastCol
SourceSheet.Cells(i, j).Copy Destination:=TargetSheet.Cells(i + 9, j)
Next j
Next i
End Sub
И это все. Инструкция копирования не работает со слитыми ячейками.
Надеюсь, это поможет