VBA для консолидации столбцов

Вопрос:

Я пытаюсь составить консолидированную финансовую отчетность, в которой указаны все детали дочернего и консолидированного показателя в последнем столбце (я планирую использовать формулу для общей консолидированной цифры). Я пытаюсь скопировать некоторый конкретный столбец рабочего листа (пусть говорят, столбец C) из выбранных файлов (каждый файл имеет только один лист с точно такой же компоновкой, структурой и базовыми данными), затем вставьте его в один мастер-лист (недавно добавленный), чтобы показать деталь столбца C из каждого файла в столбце B мастер-листа слева направо. Кроме того, я хочу показать имя каждого файла в строке 1 основного листа, но я все еще не могу понять, как его поместить в мой код.

Вот мой код. До сих пор, после того, как я запустил его в excel 2010, я обнаружил, что каждый столбец один и тот же. Я не знаю, что пошло не так. У меня есть более 60 файлов для этой подробной консолидации. Любая помощь будет очень оценена. Спасибо.

Sub CombineSheetColumn()
Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As FileDialog
Dim MaxNumberFiles As Long, FileIdx As Long, _
HeaderRow As Long
Dim DataRng As Range, OutRng As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False
'initialize constants

HeaderRow = 2 'assume headers are always in row 2
LastOutCol = 1

'select files
Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
With TargetFiles
.AllowMultiSelect = True
.Title = "Multi-select target data files:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With

'set up the output workbook
Set OutBook = Workbooks.Add
Set OutSheet = OutBook.Sheets(1)

'loop through all selected files
For FileIdx = 1 To TargetFiles.SelectedItems.Count
'open the file and assign the workbook/worksheet
Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
Set DataSheet = DataBook.ActiveSheet

Set DataRng = Range(DataSheet.Cells(HeaderRow + 1, 3), DataSheet.Cells(32, 3))
Set OutRng = Range(OutSheet.Cells(HeaderRow + 1, 2), OutSheet.Cells(32, LastOutCol + 1))
'copy the data to the outbook
DataRng.Copy OutRng

'close the data book without saving
DataBook.Close False

'update the last outbook row
LastOutCol = OutSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Next FileIdx
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Ответ №1

чтобы получить имя файла исходной книги, вы можете использовать:

Cells(32, LastOutCol + 1).value=TargetFiles.SelectedItems(FileIdx).Name

и, как и для всех одинаковых данных, вы можете пройти и проверить столбцы, которые копируются в исходной книге на каждой итерации цикла, добавив точку останова в строке:

DataRng.Copy OutRng

Оцените статью
TechArks.Ru
Добавить комментарий