Извлечение данных из нескольких рабочих книг на основе динамического списка.

1
9

Я написал этот элементарный code VBA для извлечения данных из нескольких рабочих книг.

Он открывает электронные таблицы на основе формул конкатенации в диапазоне листа 5 C3:C20, включая путь к файлу и имя листа, из которого я хочу извлечь данные. Этот диапазон является динамическим, поэтому чаще всего большинство ячеек пустые, что, как вы можете себе представить, мешает моему codeу работать. Есть ли способ изменить code, чтобы он проходил по диапазону C3:C20 и извлекал данные только в том случае, если ячейка не пустая? Я делал что-то подобное в прошлом, например

но прошли годы, поэтому я больше не уверен, как делать эти циклические codeы.

Спасибо!

Sub AllocationPull()
Dim wkb1 As Excel.Workbook
Dim wkb2 As Excel.Workbook
Dim wkb3 As Excel.Workbook
Dim wkb4 As Excel.Workbook
Dim wkb5 As Excel.Workbook
Dim wkb6 As Excel.Workbook

Dim wks1 As Excel.Worksheet
Dim wks2 As Excel.Worksheet
Dim wks3 As Excel.Worksheet
Dim wks4 As Excel.Worksheet
Dim wks5 As Excel.Worksheet
Dim wks6 As Excel.Worksheet

Application.ScreenUpdating = False

Set wkb1 = ThisWorkbook
Set wkb2 = Excel.Workbooks.Open(Sheet5.Range("C3").Value)
Set wkb3 = Excel.Workbooks.Open(Sheet5.Range("C4").Value)
Set wkb4 = Excel.Workbooks.Open(Sheet5.Range("C5").Value)
Set wkb5 = Excel.Workbooks.Open(Sheet5.Range("C6").Value)

Set wks1 = wkb1.Worksheets("Backend2")
Set wks2 = wkb2.Worksheets(Sheet5.Range("S3").Value)
Set wks3 = wkb3.Worksheets(Sheet5.Range("S4").Value)
Set wks4 = wkb4.Worksheets(Sheet5.Range("S5").Value)
Set wks5 = wkb5.Worksheets(Sheet5.Range("S6").Value)

With wks2
.Range("A1:B30").Copy Destination:=wks1.Range("A2")
End With
wkb2.Close SaveChanges:=False

With wks3
.Range("A1:B30").Copy Destination:=wks1.Range("C2")
End With
wkb3.Close SaveChanges:=False

With wks4
.Range("A1:B30").Copy Destination:=wks1.Range("E2")
End With
wkb4.Close SaveChanges:=False

With wks5
.Range("A1:B30").Copy Destination:=wks1.Range("G2")
End With
wkb5.Close SaveChanges:=False



Application.ScreenUpdating = True


End Sub
Dim lastrow As Long
Dim i As Long, j As Long
Dim wkb As Excel.Workbook

For i = lastrow to 2 Step -1
Нинель
Вопрос задан18 июля 2024 г.

1 Ответ

Ваш ответ

Загрузить файл.