VBA - transfer data from one worksheet to another based on unique reference

[jess88]

Hi,

I'm a new user to VBA, and a bit stuck!

I've developed a form (Sheet A) which has a series of boxes to be completed to report on the status of a project. Once complete the user presses a macro-enabled submit button, then the code within VBA identifies the unique reference and copies the information across to the relevant worksheet (Sheets B - I). For most of the text boxes I have code which copies the information to the correct cells on the destination worksheet. At the end of the Sub, it then resets Sheet A for the next submission.

I am now on the final section for data transfer within this Sub. I have a table on Sheet A (populating cells C23:M32). I want to copy all rows in this table containing data, and paste them in a table on the corresponding sheet (B-I) (table range C24:M24). The data should be pasted into the next available row. Any blank rows from table on the source sheet should be ignored. Once they have been copied across, the cell in column B in the corresponding row should be dated with the day of submission (this can be taken from the main form if required).

I've uploaded two screenshots - the first is the reporting form (sheet A). You can see the cells I'm referring to in the table with the drop down. The second is one of the destination sheets of which there are 8 (Sheets B - I). The reference in cell G7 on the reporting form determines which sheet the information is entered into. As you can see, the script currently allows the text from the other boxes to populate the destination sheet ("test" in C9 and F9), but the next bit is where the script enters an issue!

Any help would really be appreciated!

 

[DanteAmor]

Hi and welcome to MrExcel.

I have a table on Sheet A (populating cells C23:M32). I want to copy all rows in this table containing data, and paste them in a table on the corresponding sheet (B-I) (table range C24:M24).

For that part, use the following code:

Sub Transfer_Data()
  Dim shA As Worksheet, shd As Worksheet
  Dim i As Long, j As Long
 
  Set shA = Sheets("Sheet A")
  Set shd = Sheets(shA.Range("G7").Value)
 
  j = 24
  For i = 23 To 31
    If shA.Range("C" & i).Value <> "" Then
      Do While shd.Range("D" & j).Value <> ""
        j = j + 1
      Loop
      shd.Range("B" & j).Value = shA.Range("C" & i).Value
      shd.Range("C" & j).Value = shA.Range("J" & i).Value
      shd.Range("D" & j).Value = shA.Range("M" & i).Value
    End If
  Next
End Sub