Вставка таблицы данных Excel в виде одной строки, а не нескольких
Сценарий делает именно то, что мне нужно, но он вставляет входной диапазон (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
Есть идеи?
1 ответ
Решение
Попробуйте изменить:
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
Это сохранит макет, то есть данные будут вставлены в тот же диапазон, из которого они были скопированы.