Извлечение данных из одного листа в другой лист - PullRequest
0 голосов
/ 12 октября 2019

Я надеюсь, что кто-то может мне помочь, потому что я пробовал много предложений с других сайтов, но не могу найти решение.

У меня есть одна электронная таблица Dashboard и около 30+ электронных таблиц отдела (см. Прилагаемые снимки).

Какой будет наилучший способ получения данных, я скоро выберу «Название» отдела (название отдела иимена соответствующих таблиц и таблиц совпадают)

Не могли бы вы помочь мне с VBA или макросом? Большое спасибо !!

Электронная таблица получена из другого отдела:

enter image description here

Сводная таблица / Электронная таблица

enter image description here

1 Ответ

0 голосов
/ 12 октября 2019

Попробуйте это:

Прежде всего, вам нужен список со всеми листами. Для этого используйте эту функцию:

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

И это все. Инструкция копирования не работает со слитыми ячейками.

Надеюсь, это поможет

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...