Copy/Paste Data From Multiple 'Data' Workb

2019-07-08 10:24发布

问题:

GIVEN

a) A workbook (MainWorkBook) with 2 worksheets:

  • Main1: To enter the start and end date, to select (up to) 15 (3 x 5) values from 15 different dropdown menus, and 17 parameters that can be selected with a checkbox (The form control checkbox is linked to the underlying cell ($B10:$B26)).
  • Main2: To copy the results (Starting at B2).

b) Many workbooks (DataWorkBook) for several companies (CompanyXX) that come in several 'versions' (VersionXX), that each have several worksheets (DataWorkSheet: TypeXX).

PURPOSE

The idea is to import (paste) all of the data from the (data) workbooks into the "Main2" worksheet of the (main) workbook based on the selections that were made on the "Main1" worksheet: start/end date, companies, versions, types, and the parameters that were selected by the checkboxes.

See screenshots below:

QUESTION

What is working thus far, is that I'm able to open the correct workbook(s) at the correct worksheet, and I'm able to copy/paste pre-set rows of data (Code has been removed in the example below), but I'm still not able to copy/paste data for the selected rows (The rows selected by the checkboxes) between start and end date...

CODE (ATTEMPT)

Sub ImportData()

Dim MainWorkBook As Workbook
Dim DataWorkBook As Workbook
Dim MainWorkSheet As Worksheet
Dim DataWorkSheet As Worksheet
Dim i As Long
Dim Type As String
Dim j As Long
Dim StartDate As Date
Dim EndDate As Date
Dim DataRange As Range
Dim Data As Range
Dim TargetRow As Long
Dim TargetColumn As Long
Dim ChkBox As Shape

Application.ScreenUpdating = False

Set MainWorkBook = ActiveWorkbook
Set MainWorkSheet = MainWorkBook.Worksheets("Main1")

With MainWorkBook.ActiveSheet

StartDate = Cells(3, 3).Value
EndDate = Cells(4, 3).Value

For i = 3 To 7

If MainWorkSheet.Cells(6, i).Value <> "" Then

Type = MainWorkSheet.Cells(8, i).Value
Set DataWorkBook = Workbooks.Open("D:\ 'Some folders' \" & .Cells(6,  
i).Value & "-" & .Cells(30, 2) & "-" & .Cells(7, i).Value & ".xlsx")
DataWorkBook.Worksheets(Type).Select

TargetRow = 2
TargetColumn = 2
j = 1

For Each ChkBox In MainWorkSheet.Shapes
If ChkBox.Type = msoFormControl Then
If ChkBox.FormControlType = xlCheckBox Then
If ChkBox.ControlFormat.Value = xlOn Then
Set DataWorkSheet = DataWorkBook.Worksheets(Tomato)
Set DataRange = Application.Intersect(DataWorkSheet.Range("B4:SZ4"),    
DataWorkSheet.UsedRange)
For Each Data In DataRange.Cells
If Data.Value >= StartDate And Data.Value <= EndDate Then
Set TargetWorkSheet = MainWorkBook.Worksheets("Main2")
Data.Offset(j, 0).Resize(1, 1).Copy _
TargetWorkSheet.Cells(TargetRow, TargetColumn)
TargetRow = TargetRow + 1
End If
Next Data
TargetColumn = TargetColumn + 1
End If
End If
End If
Next ChkBox

On Error Resume Next

End If

DataWorkBook.Close savechanges:=False

Next i

End With

Application.ScreenUpdating = True

End Sub

Anybody who wants to give it a shot? :-)

Any help is appreciated!

NOBODY?