none
Macro assign to button - Enquiry Sheet fill in form then upon click copies to another sheet keeping formulas. RRS feed

  • Question

  • Hi- I need help. Very new to macro's and I managed to set up a macro that copies inputted contents In New Enquiry Worksheet from B3 to B23 to a table in Enquiry Log Worksheet and then deletes the contents from those cells also. Only thing is I had formulas in B5 and B13 that I want to keep for the next entry.

    Also I'd like the contents to be copied to the top cell rather than add to the bottom - to keep the most recent enquiry at the top of the table.

    Anyone have any ideas how I would set this up? I have copied the code I have in there now is at the bottom.

    Thanks


    Private Sub CommandButton1_Click()
    Dim temp As String
    Dim rng, rng1 As Range
    Dim row, row1 As Range
    Dim cell, cell1 As Range
    Dim sht1, sht2 As Worksheet
        Set sht1 = Sheets(1)
        Set sht2 = Sheets(2)
        Set rng = sht1.Range("B3:B23")
    Dim lastrow As Long
        lastrow = sht2.Cells(sht2.Rows.Count, "C").End(xlUp).row + 1
    Dim x, y As Integer
        x = 0
        y = 0
        Set rng1 = sht2.Range("A" & lastrow & ":U" & lastrow)
            For Each row In rng.Rows
                  For Each cell In row.Cells
                    x = x + 1
                    'Debug.Print (cell.Value)
                    temp = cell.Value
                    y = 0
                            For Each row1 In rng1.Cells
                                              
                                y = y + 1
                                If x = y Then
                                    row1.Value = temp
                                    'Debug.Print (row1.Value)
                                    End If
                                            
                            Next row1
                Next cell
            Next row
            rng.Value = ""
    End Sub

    Friday, October 20, 2017 3:43 AM

All replies

  • Hi Ninaz04,

    How about this?
    (this code will insert a new row and always paste value on Row 3)
    Private Sub CommandButton1_Click()
        Dim temp As String
        Dim rng, rng1 As Range
        Dim row, row1 As Range
        Dim cell, cell1 As Range
        Dim sht1, sht2 As Worksheet
        Set sht1 = Sheets(1)
        Set sht2 = Sheets(2)
        Set rng = sht1.Range("B3:B23")
        Dim x, y As Integer
        x = 0
        y = 0
        Set rng1 = sht2.Range("A2:U2")
        ' ---
        Dim idx As Integer: idx = 0
        For Each row In rng.Rows
            idx = idx + 1
            If (idx = 1) Then
                sht2.Rows(2).Insert
            End If
            For Each cell In row.Cells
                x = x + 1
                temp = cell.value
                y = 0
                For Each row1 In rng1.Cells
                    y = y + 1
                    If (x = y) Then
                        row1.value = temp
                    End If
                Next row1
            Next cell
        Next
        rng.value = ""
    End Sub

    Regards,

    Ashidacchi


    Friday, October 20, 2017 6:37 AM
  • Hi,

    This is the forum to discuss questions and feedback for Microsoft Excel features, I'll move your question to the MSDN forum for Excel

    https://social.msdn.microsoft.com/Forums/en-US/home?forum=exceldev

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.


    Regards,
    Emi Zhang
    TechNet Community Support

    Please remember to mark the replies as answers if they helped.
    If you have feedback for TechNet Subscriber Support, contact tnmff@microsoft.com.

    Monday, October 23, 2017 1:57 AM
  • Hello,

    Does the code Ashidacchi shared work for you?

    If you have any issue, please let us know. It would be helpful if you could share your workbook and your expected result.

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Thursday, October 26, 2017 8:47 AM
    Moderator