脚本正在完成我需要它做的事情,但它将输入范围(A7:B30)插入一行,而不是现有的格式。
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 :(得分: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
这将保留布局,即数据将被粘贴到从中复制的相同范围。