I need to create a macro that upon selecting command button, will do the following:
-
Copy the cell values from C8, D8, E8, F8, H7, H8, on Sheet1 and paste those cell values in the following order into a table on Sheet2: C8 into A2, D8 into B2, E8 into C2, E8 into D2, H7 into H2, H8 into I2 (Table has 9 columns, starts in cell A1, and includes Header.)
-
It would have to repeat the process but this time copy the values from C8, D8, E8, F8, I7, I8, on Sheet1 and paste those cell values into the next empty row of the table in the following order on Sheet2: C8 into A3, D8 into B3, E8 into C3, E8 into D3, I7 into H3, I8 into I3. It would loop through this process until Column M is reached. If there were not value in any of the columns H-N (7 COLUMNS), it would skip that column and go to the next.
-
It would then have to go back to Sheet1, and repeat the process for the following values. Copy the cell values from C10, D10, E10, F10, H10, H10, on Sheet1 and then...
-
would have to past those values into the same table on Sheet2 in the following order: C10 into A8, D10 into B8, E10 into C8, E10 into D8, H9 into H8, H10 into I8. (Row 10 selected cells would be copied from Sheet1 and pasted into Row 8 on Sheet2 ONLY if the cell value of C8 on Sheet 1 contained values for each cell in the range of Column H-N. If it didnt, let's say C8 on Sheet1 did not have a value in I8, then when the code completed the first main loop (C8 on Sheet 1 and associated Columns H-N) and began the subloop (C8-C78 on Sheet1) it would then pasted values into row 7 of Sheet 2 instead of row 8 since there were no values in Column I on Sheet1.
- This process would be repeated as long as Rows 8-68, Column C on Sheet1 contained a value in their cells.
The following code is my attempt...
Private Sub CommandButton1_Click()
Dim item1 As Range, SrchRng As Range, c As Range
SrchRng = Range("C7:C68")
item1 = Range("C8:F8")
Sheets("Sheet1").Select
item1.Rows(8).Select
Selection.Copy
For Each c In Sheets("Sheet1").Range("SrchRng")
If c.Value <> "" Then
For i = 1 To 3
Cells(1, i).Value = i
Selection.Copy
Sheets("Sheet2").Select
If Sheets("Sheet2").Range("A1").Offset(1, 0) <> "" Then
Sheets(Sheet2").Range("A1").End(exlDown).Select
End If
Selection.Paste
End If
End Sub
Aucun commentaire:
Enregistrer un commentaire