mardi 4 juillet 2017

Copy and specified cells from one sheet to another

I need to create a macro that upon selecting command button, will do the following:

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

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

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

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

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