我想从Workbook1.xlsm
复制一系列单元格并将其插入Workbook2.xltm
。
我需要在Workbook2
中插入足够的行来“应对”数据的大小,这会有所不同。感谢jspek我有以下宏,但这不会在Workbook2
中插入行。
从很多谷歌搜索来到this。我只能看到我需要使用.Resize
。
sub rangeCopy()
Dim sourceRange As Range, loopRange As Range
Dim targetRange As Range
Dim lastRow As Long
Dim sourceCounter As Long
Dim targetCounter As Long
Dim outString As String
Dim startRow As Long
Dim startCol As Long
Dim endCol As Long
Dim colCounter As Long
Set sourceRange = Sheets("Input Sheet").Range("A9:C800")
Set targetRange = Workbooks.Open("C:\Users\j\Documents\Workbook2.xltm").Sheets("Quote").Range("A4")
startRow = sourceRange.Row
lastRow = sourceRange.Rows.Count
startCol = sourceRange.Column
endCol = sourceRange.Columns.Count - 1
Set loopRange = sourceRange.Parent.Cells(startRow, startCol)
For colCounter = 0 To endCol
targetCounter = 0
For sourceCounter = 0 To lastRow - 1
outString = Trim(loopRange.Offset(sourceCounter, colCounter).Value)
While (Trim(targetRange.Offset(targetCounter, colCounter).Value) <> "")
targetCounter = targetCounter + 1
Wend
targetRange.Offset(targetCounter, colCounter).Value = outString
Next
Next
End Sub
答案 0 :(得分:0)
只是我想要建议您需要进行更改并调试以满足您的需求的想法
sub rangeCopy()
Dim p As long
Set targetRange = Workbooks.Open("C:\Users\j\Documents\Workbook2.xltm").Sheets("Quote").Range("A4")
Dim FRow As Long
Dim m As Long
m =Sheets("Input Sheet").Rows.Count
FRow = Sheets("Input Sheet").Range("A" & m).End(xlUp).Row
Set sourceRange = Sheets("Input Sheet").Range("A9:C" &FRow)
sourceRange.Copy
Sheets("Quote").Rows("4:4").Select Selection.Insert Shift:=xlDown
p= FRow + 5
Sheets("Quote").Rows("4:" & p).Copy
Sheets("Quote").Rows("4:4").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub