2016-06-10 37 views
0

該腳本正在做我所需要的操作,但它將輸入範圍(A7:B30)插入到單行而不是現有格式。Excel datasheet條目作爲單行插入,不是多個

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 

這將保留佈局,即,數據將被粘貼到它是從複製的相同的範圍。