将数据复制并粘贴到最后一行

时间:2018-04-16 06:51:01

标签: excel-vba vba excel

我有下面的代码,这一切都适用于MyCopy10。但是下一个代码MyCopy100没有复制工作表实际电子邮件的最后一行中的数据。我不确定问题是什么。

这是我的代码:

Sub MyCopy10()
Dim myCols As Variant
Dim lastRow As Long
Dim c As Long

Sheets("Eamil-10").Activate

'Set columns you want to loop through in an array
myCols = Array("A", "B", "C", "D")

 '   Loop through columns array
For c = LBound(myCols) To UBound(myCols)
  '   Find last row in column A with data
    lastRow = Sheets("Eamil-10").Cells(Rows.Count, myCols(c)).End(xlUp).Row
 '       Copy data from Model sheet to summary sheet
    Sheets("Eamil-10").Range(Cells(1, myCols(c)), Cells(lastRow, 
 myCols(c))).Copy
    Sheets("Actual Email").Cells(1, c + 1).PasteSpecial Paste:=xlValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Next c
 '     Sheets("Summary").Activate
 End Sub

Code:
 Sub MyCopy100()
Dim myCols As Variant
Dim lastRow As Long
Dim c As Long

  Sheets("Email-100").Activate

    '   Set columns you want to loop through in an array
    myCols = Array("A", "B", "C", "D")

    '   Loop through columns array
     For c = LBound(myCols) To UBound(myCols)
   '   Find last row in column W with data
    lastRow = Sheets("Email-100").Cells(Rows.Count, myCols(c)).End(xlUp).Row
    '       Copy data from Model sheet to summary sheet
    Sheets("Email-100").Range(Cells(1, myCols(c)), Cells(lastRow, 
     myCols(c))).Copy
    Sheets("Actual Email").Cells(1, c + 1).PasteSpecial Paste:=xlValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
  Next c
'     Sheets("Summary").Activate
 End Sub

1 个答案:

答案 0 :(得分:0)

尝试以下代码,所有RangeCells都符合Sheets("Email-100")

<强>代码

Option Explicit

Sub MyCopy100()

Dim myCols As Variant
Dim lastRow As Long
Dim c As Long

' Set columns you want to loop through in an array
myCols = Array("A", "B", "C", "D")

With Sheets("Email-100")
    ' Loop through columns array
    For c = LBound(myCols) To UBound(myCols)
        ' Find last row in column with data
        lastRow = .Cells(.Rows.Count, myCols(c)).End(xlUp).Row

        ' Copy data from Model sheet to summary sheet
        .Range(.Cells(1, myCols(c)), .Cells(lastRow, myCols(c))).Copy
        Sheets("Actual Email").Cells(1, c + 1).PasteSpecial Paste:=xlValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        Application.CutCopyMode = False
    Next c
End With

End Sub