将多个列中的值复制到另一个工作表中

时间:2016-05-12 19:46:59

标签: excel-vba excel-2013 vba excel

我有一个工作簿需要将第一个工作表中的第I,K和M列的数据复制到最后一个工作表的A列。列I,K和M中的单元格包含vlookup公式。我已经尝试过代码(如下所示),但它复制的是公式而不是这些公式返回的值。 vlookup公式在每列的第2行到第201行中,但并非所有列都具有要返回的值。

如何将值复制到最后一个工作表的A列中?

Sub Create_Email_Distro()
'
    ' The following is a list of all the Source worksheets

    Dim PTASK_Template As Workbook ' source WorkBook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim PTASK As Worksheet
        Set PTASK = PTASK_Template.Sheets("BCRS Unassigned Tasks")
    Dim EDLd As Worksheet
        Set EDLd = PTASK_Template.Sheets("Email Distro")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Copy WGM email addresses to Email Distro sheet

    Dim LRWGM As Long
    LRWGM = PTASK.Range("K" & PTASK.Rows.Count).End(xlUp).Row
    Dim EDLRowW As Long
    EDLRowW = EDLd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
    PTASK.Range("K2:K" & LRWGM).Copy EDLd.Range("A" & EDLRowW)

    ' Copy SWGM emaill addresses to Email Distro sheet

    Dim LRSWGM As Long
    LRSWGM = PTASK.Range("M" & PTASK.Rows.Count).End(xlUp).Row
    Dim EDLRowS As Long
    EDLRowS = EDLd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
    PTASK.Range("M2:M" & LRSWGM).Copy EDLd.Range("A" & EDLRowS)

    ' Copy AGD emaill addresses to Email Distro sheet

    Dim LRAGD As Long
    LRAGD = PTASK.Range("I" & PTASK.Rows.Count).End(xlUp).Row
    Dim EDLRowA As Long
    EDLRowA = EDLd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
    PTASK.Range("I2:I" & LRAGD).Copy EDLd.Range("A" & EDLRowA)

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

我在这里看了几个类似的问题,但是我无法找到一个从动态范围复制并将3列数据堆叠成一个的问题。

示例:enter image description here

0 个答案:

没有答案