Excel VBA使用“调整大小”插入复制数据的行数

时间:2016-01-30 17:40:56

标签: excel vba excel-vba

我想从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

1 个答案:

答案 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