Search code examples
vbaexceldata-entrydatasheet

Excel datasheet entry inserting as single row, not multiple


The script is doing exactly what I need it to do, but it's inserting the input range (A7:B30) into a single row, rather than the existing format.

Sub UpdateLogWorksheet()
    'http://www.contextures.com/xlForm02.html

    Dim dataWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range

    'cells to copy from Input sheet - some contain formulas
    myCopy = "A7:B30"

    Set inputWks = Worksheets("Input")
    Set dataWks = Worksheets("Data")

    With dataWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
        Set myRng = .Range(myCopy)

    End With

    With dataWks
    With .Cells(nextRow, "A")
        .Value = ""
        .NumberFormat = "dd/mm/yyyy"
    End With
    .Cells(nextRow, "D").Value = "HELLO"
    oCol = 3
    For Each myCell In myRng.Cells
        dataWks.Cells(nextRow, oCol).Value = myCell.Value
        oCol = oCol + 1
    Next myCell
    End With

    'clear input cells that contain constants
    With inputWks
    On Error Resume Next
     With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
          .ClearContents
          Application.GoTo .Cells(1) ', Scroll:=True
     End With
     On Error GoTo 0
    End With
End Sub

Any ideas?


Solution

  • Try changing:

    For Each myCell In myRng.Cells
        dataWks.Cells(nextRow, oCol).Value = myCell.Value
        oCol = oCol + 1
    Next myCell
    

    to

    For Each myCell In myRng.Cells
        dataWks.Range(myCell.Address).Value = myCell.Value
    Next myCell
    

    That will preserve the layout, i.e. the data will be pasted into the same range it was copied from.