how to copy specific cells of data (skipping blank cells) into another worksheet into next blank row?

Question

I have a spreadsheet that survey's equipment condition for multiple types of equipment (see Data Input example). For each row I need the equipment under the columns header "E1" and "E1C" copy/pasted into another worksheet ("ET target" in example) with the ID number and then "E2" & "E2C" copy pasted into next blank row with the same ID. keep doing this for each nonblank cells in each row.

Data Input example

The "Data Output Example" image can help explain what I mean.

I've tried a few things and read quite a few posts, but havent found anything that i could combine together to work. Below is what im working on currently, but is far from complete.

EDIT: new code so far. works, but would like to learn how to loop and skip blanks

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

Dim source As Worksheet, target As Worksheet


    'range is B:L.  B8:L8 empty so skipped
    'next is B9:L9.  skip J9:L9 becuase empty
    Sheets("Source").Range("B9:C9,A9").Copy
    Sheets("ET target").Range("A2").PasteSpecial xlValues
    Sheets("Source").Range("D9:E9,A9").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("D9:E9,A9").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("F9:G9,A9").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("H9:I9,A9").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    'Skip B10:L10 empty.  Next is B11:L11.  Skip F11:L11 becuase empty
    Sheets("Source").Range("B11:C11,A11").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("D11:E11,A11").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    'Skip B12:L14 becuase empty.  Next is B15:L15.  skip H15:L15 becuase empty
    Sheets("Source").Range("B15:C15,A15").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("D15:E15,A15").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("F15:G15,A15").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    'Repeat for upto 200 rows.

'Same steps but for other Equipment.
'Range is M:AB. Skip
Sheets("Source").Range("M9:N9,A9").Copy
Sheets("UT target").Range("A2").PasteSpecial xlValues

Application.ScreenUpdating = True

End Sub

Answer 1

Have you tried to specify the SkipBlanks argument of the PasteSpecial function ?

It would look like something like this with your code :

Sheets("Source").Range("B9:C9,A9").Copy
Sheets("ET target").Range("A2").PasteSpecial Paste:=xlValues, SkipBlanks:=True

See the Range.PasteSpecial method (Excel) for more information.