Importing defined columns from selected workbook sheets

Greetings again

I'd like to open a openfile dialog and select a specific workbook, then on Sheet1 of that workbook copy specific column into the current workbook under a newly created sheet name "TESTSHEET"

I've been working with this code but so far I'm unble to select the specific columns I want and copy them over.

Question:
I want to copy Ranges C1:F?, J1:K? where the ? is the last datarow in column D of customerWorkBook.WorkSheets(1) and paste it to Range B1:G? of targetWorkBook("testsheet")?

Private Sub Import1_Click()
' Get customer workbook...
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook

' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook
ActiveWorkbook.Worksheets.Add(After:=ActiveSheet).Name = "testsheet"

' get the customer workbook
filter = "Text files (*.xls),*.xls"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)

Set customerWorkbook = Application.Workbooks.Open(customerFilename)

' assume first range is C1 - G? in sheet1
' copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)

' F30, K30 of sourceSheet and E34,G34 of targetSheet are just place holders until I sort out the true value of the length of D column data

targetSheet.Range("B8:E34").Value = sourceSheet.Range("C1:F30").Value
targetSheet.Range("F8:G34").Value = sourceSheet.Range("J1:K30").Value

' Close customer workbook
customerWorkbook.Close

End Sub

Additional question;

I have 20 checks to make, if true, then insert 2 entire rows.

I think this should be a While, If Then function, but I'm not sure how to form it.

ActiveWorkbook.Worksheets("EPB").Columns(7).Find("C 00").Select
ActiveCell.EntireRow.Insert
ActiveCell.EntireRow.Insert
ActiveWorkbook.Worksheets("EPB").Columns(7).Find("M 01").Select
ActiveCell.EntireRow.Insert
ActiveCell.EntireRow.Insert
ActiveWorkbook.Worksheets("EPB").Columns(7).Find("M 02").Select
ActiveCell.EntireRow.Insert
ActiveCell.EntireRow.Insert
ActiveWorkbook.Worksheets("EPB").Columns(7).Find("M 03").Select
ActiveCell.EntireRow.Insert
ActiveCell.EntireRow.Insert
' and so on....

This portion of thevba code works, but its obviously very bulky

Any way to clean this up?

I had to add lastrow=lastrow+1 to account for the extra spaces being inserted or the function stopped at the original lastrow value which left several sections without row spaces.

'Insert row above active cell
'ActiveCell.EntireRow.Insert
Dim ws As Worksheet:
Set ws = Sheets("EPB")
Dim lastrow As Long
Dim iFind As Range

lastrow = ws.Range("G" & Rows.Count).End(xlUp).Row
    Set iFind = ws.Range("G1:C" & lastrow).Find(What:="C 00", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
    Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 01", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
    Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 02", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
    Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 03", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
    Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 04", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
    Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 05", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
    Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 06", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
    Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 07", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
    Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 08", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
    Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 09", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
    Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 10", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
        Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 11", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
        Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 12", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
        Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 14", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
        Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 15", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
        Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 16", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
        Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 17", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
        Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 18", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
        Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 19", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
        Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 20", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
        Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 21", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        lastrow = lastrow + 1
    End If
        Set iFind = ws.Range("G1:C" & lastrow).Find(What:="M 22", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.EntireRow.Insert Shift:=xlDown
        'lastrow = lastrow + 1
    End If

Still on this bit of code, time to take a break.

In the vba code section of Sheet1
partial code,

Dim ws As Worksheet:
Set ws = Sheets("EPB")
Dim LastRow As Long
Dim iFind As Range
Dim m1, m2, m3, m4, m5, m, m7, m8, m9, m10, m11, m12, m14, m15, m16, m17, m18, m19, m20, m21, m22, mOtr As Long

LastRow = ws.Range("H" & Rows.Count).End(xlUp).Row
    Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 01", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m1 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 2
    End If
    Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 02", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m2 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
    Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 03", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m3 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
    Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 04", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m4 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
    Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 05", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m5 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
    Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 06", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m6 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
    Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 07", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m7 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
    Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 08", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m8 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        iFind.FormatConditions.Delete
        LastRow = LastRow + 1
    End If
    Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 09", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m9 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
    Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 10", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m10 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
        Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 11", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m11 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
        Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 12", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m12 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
        Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 14", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m14 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
        Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 15", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m15 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
        Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 16", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m16 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
        Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 17", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m17 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
        Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 18", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m18 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
        Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 19", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m19 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
        Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 20", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m20 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
        Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 21", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m21 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
        Set iFind = ws.Range("H1:C" & LastRow).Find(What:="M 22", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        m22 = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If
    Set iFind = ws.Range("H1:C" & LastRow).Find(What:=" ", LookIn:=xlValues, LookAt:=xlWhole)
    If Not iFind Is Nothing Then
        iFind.Activate
        mOtr = ActiveCell.Row - 1
        iFind.EntireRow.Insert Shift:=xlDown
        LastRow = LastRow + 1
    End If

I need to pass the variables;

Dim m1, m2, m3, m4, m5, m, m7, m8, m9, m10, m11, m12, m14, m15, m16, m17, m18, m19, m20, m21, m22, mOtr As Long

Over to the "EPB_Template" Sheet to handle the variables there;

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

  With Target
        If Not Application.Intersect(Target, Range("I9:I" & m1, "I" & m1+1 & ":I" & m2, "I" & m2+1 & ":I" & m3,  etc , etc to , "I" & m22+1 & ":I" & mOtr, )) Is Nothing Then
            Cancel = True
            .Value = IIf(.Text = "IN", "OUT", "IN")
            
            If .Value = "IN" Then
                ' do something
                With .Interior
                    .ColorIndex = 4
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                End With
            Else
                ' do something else
                With .Interior
                    .ColorIndex = 3
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                End With
            End If
            
        End If
    End With
End Sub

With the sheer amount of repetition, I still cannot find a workable loop to cut this down.

Any suggestions?