I have a spreadsheet that survey's equipment condition for equipment condition for multiple places, which is designated by ID (see Data Input example). For each row I need the equipment under the columns header "E1" and "E1C" copy/pasted into another worksheet ("Data Output") with the ID number associtated with that row and then "E2" & "E2C" copy pasted into next blank row with the same ID. Keep looping through the columns and skip the nonblank cells in each row. After going through all the columns in a row it should go to the next row until there is a row with no data (blank row).
Data Input example (smaller example of what the table looks like)
[TABLE="width: 791"]
<colgroup><col><col><col span="10"></colgroup><tbody>[TR]
[TD]ID[/TD]
[TD]E1[/TD]
[TD]E1C[/TD]
[TD]E2[/TD]
[TD]E2C[/TD]
[TD]E3[/TD]
[TD]E3C[/TD]
[TD]E4[/TD]
[TD]E4C[/TD]
[TD]E5[/TD]
[TD]E5C[/TD]
[TD]ET5C[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[TD]N2000D+[/TD]
[TD]9[/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]N2000D+[/TD]
[TD]2[/TD]
[TD]N2000D [/TD]
[TD]5[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]N2000D+[/TD]
[TD]9[/TD]
[TD]N2000D+[/TD]
[TD]0[/TD]
[TD]N2000D+[/TD]
[TD]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]18[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]19[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]20[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]195[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[TD]N2000D+[/TD]
[TD]8[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
The "Data Output Example" image can help explain what I mean.
[TABLE="width: 211"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]ID[/TD]
[TD]Model[/TD]
[TD]Condition[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]N2000D+[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]N2000D[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]N2000D+[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]N2000D+[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]N2000D+[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]195[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]195[/TD]
[TD]N2000D+[/TD]
[TD]8
[/TD]
[/TR]
</tbody>[/TABLE]
The code i have so far does what the intended output should do, but it is hard coded instead of looping through the rows/columns and automatically skipping blank cells.
Option Explicit
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim source As Worksheet, target As Worksheet
Dim r As Range, rB As Range
'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.
Application.ScreenUpdating = True
End Sub
Sorry if there is duplicate threads somewhere. I have looked through quite a few posts and did not find anything that i could tailor to fit. Thanks for your help!
Data Input example (smaller example of what the table looks like)
[TABLE="width: 791"]
<colgroup><col><col><col span="10"></colgroup><tbody>[TR]
[TD]ID[/TD]
[TD]E1[/TD]
[TD]E1C[/TD]
[TD]E2[/TD]
[TD]E2C[/TD]
[TD]E3[/TD]
[TD]E3C[/TD]
[TD]E4[/TD]
[TD]E4C[/TD]
[TD]E5[/TD]
[TD]E5C[/TD]
[TD]ET5C[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[TD]N2000D+[/TD]
[TD]9[/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]N2000D+[/TD]
[TD]2[/TD]
[TD]N2000D [/TD]
[TD]5[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]N2000D+[/TD]
[TD]9[/TD]
[TD]N2000D+[/TD]
[TD]0[/TD]
[TD]N2000D+[/TD]
[TD]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]18[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]19[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]20[/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]195[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[TD]N2000D+[/TD]
[TD]8[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
The "Data Output Example" image can help explain what I mean.
[TABLE="width: 211"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]ID[/TD]
[TD]Model[/TD]
[TD]Condition[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]N2000D+[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]N2000D[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]N2000D+[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]N2000D+[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]N2000D+[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]195[/TD]
[TD]N600D[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]195[/TD]
[TD]N2000D+[/TD]
[TD]8
[/TD]
[/TR]
</tbody>[/TABLE]
The code i have so far does what the intended output should do, but it is hard coded instead of looping through the rows/columns and automatically skipping blank cells.
Option Explicit
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim source As Worksheet, target As Worksheet
Dim r As Range, rB As Range
'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.
Application.ScreenUpdating = True
End Sub
Sorry if there is duplicate threads somewhere. I have looked through quite a few posts and did not find anything that i could tailor to fit. Thanks for your help!