2016-06-10 7 views
0

Сценарий выполняет именно то, что мне нужно для этого, но он вставляет диапазон ввода (A7: B30) в одну строку, а не в существующий формат.Вставка ввода данных Excel в виде одной строки, а не нескольких

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 

Любые идеи?

ответ

0

Попробуйте изменить:

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

к

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

Это позволит сохранить компоновку, то есть данные будут вставлены в том же диапазоне, что был скопирован.