将根据参数创建数组并使用Array复制/粘贴Excel-VBA

时间:2018-03-29 15:28:28

标签: excel-vba vba excel

我创建了一个函数,它将在一个工作表中复制表的所有值,并将它们转移到第二个工作表中的单个行中。

如果我将函数变成sub并给“rows”和“cols”值赋予整数值,并将“strtCell”替换为实际单元格(即C12),那么它就可以工作。

P.S。通过在线视频了解到vba所以我仍然是初学者。任何提示将不胜感激!

工作的功能

Function COPYPASTE(RWSS As Integer, CLS As Integer, cellLoc As String, shift As Integer) As Integer

'Declare variables

Dim strtCell As Range
Dim rows As integers
Dim cols As Integer

strtCell = cellLoc
Const rows = RWSS
Const cols = CLS

Dim arrayOne((rows - 1), (cols - 1)) As Variant
Dim icounter As Integer, jcounter As Integer

'Activate workseet that needs to be copied from
Worksheets("CalculationsPerRep").Activate

'Activate first cell of the table
Range("strtCell").Activate

'Begin copy loop
For icount = 0 To (rows - 1)
    For jcount = 0 To (cols - 1)

        arrayOne(icount, jcount) = ActiveCell.offset(icount, jcount).Value

    Next jcount
Next icount

'Activate sheet that needs to be pasted in
Worksheets("Test").Activate

'Activate first cell to be pasted
Range("C4").Activate

'Declare intial offset
Dim moveRight As Integer
moveRight = shift

'Begin Paste Loop
For icounter = 0 To (rows - 1)
    For jcounter = 0 To (cols - 1)

            ActiveCell.offset(0, moveRight) = arrayOne(icounter, jcounter)
            moveRight = moveRight + 1

     Next jcounter
Next icounter

'Function will return the next empty cell in row
    COPYPASTE = moveRight

End Function

Sub CPYPSTEFUNCT()

    Dim offset As Integer
    offset = COPYPASTE(9, 10, "B12", 0)

End Sub

0 个答案:

没有答案