samedi 30 janvier 2016

Copy/Paste Data From Multiple 'Data' Workbooks To A Single 'Main' Workbook Based On A Start/End Date And Checkbox-selected Rows

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).

See screenshots in attachment.

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.

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 ChkBox As CheckBox
Dim j As Long
Dim StartDate As Date
Dim EndDate As Date
Dim DataRange As Range
Dim Data As Range
Dim TargetRow As Long

Application.ScreenUpdating = False

Set MainWorkBook = ThisWorkbook
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

MainWorkBook.Worksheets("Main1").Activate

j = 10
TargetRow = 2

For Each ChkBox In ActiveSheet.CheckBoxes
If ChkBox.Value = Checked Then

Set MainWorkSheet = MainWorkBook.Worksheets("Main2")

DataWorkBook.Sheets(Type).Activate
Set DataWorkSheet = DataWorkBook.Worksheets(Type)

Set DataRange = Application.Intersect(DataWorkSheet.Range("B4:ZZ4"),      
DataWorkSheet.UsedRange)
For Each Data In DataRange.Cells
If Data.Value >= StartDate And Data.Value <= EndDate Then
Data.Offset(j, 0).Resize(1, 2).Copy _
MainWorkSheet.Cells(TargetRow, 2)
TargetRow = TargetRow + 1
End If
Next Data

j = j + 1

End If

Next ChkBox

On Error Resume Next

End If

Next i

End With

Application.ScreenUpdating = True

End Sub

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

Any help is appreciated!

MainWorkBook DataWorkBook




Aucun commentaire:

Enregistrer un commentaire