在VBA for Excel中,尝试基于Variable将数据从一个WB复制到另一个WB

时间:2019-04-17 18:36:05

标签: excel vba

我正在尝试将数据从一个大型工作簿(每月下载一次)编译为一个更简洁的数据。我每个月都会获取新数据。我将知道源文件的名称及其位置。

下面是我要运行的代码。它似乎可以正常运行(遍历所有的FOR和DO直到),但是只是没有将数据从源文件移动到目标文件。我正在使用的变量信息是从目标WB的第14行开始的O列。我正在尝试通过源WB的A列对一些文本和来自目标WB的变量进行排序。如果有匹配项,我将尝试从匹配的单元格偏移(向下3行,右侧2列),然后将该信息复制到目标WB上的偏移单元格(同一行的左侧4列)。还可以从源的下10行和右2列复制到目标的下1行和左4列。

Sub Get_Scorecard()

    Dim SourceFile As String
    Dim DestFile As String
    Dim SourceWB As Workbook
    Dim SourceWS As Worksheet
    Dim DestWB As Workbook
    Dim DestWS As Worksheet
    Dim path As String
    Dim Msg As String
    Dim SCount As Long
    Dim sourcestart As Range
    Dim TechName As String

    'Set starting cell on Dest WS
    Range("O14").Activate


    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    'Set all the WB's and WS's
    path = Application.ThisWorkbook.path & "\"
    SourceFile = path & "March Test.xlsx"
    DestFile = path & "JobSteps 2019 Test.xlsm"
    Set SourceWB = Application.Workbooks.Open(SourceFile)
    Set SourceWS = SourceWB.Sheets(1)
    Set DestWB = Application.Workbooks.Open(DestFile)
    Set DestWS = DestWB.Sheets(1)


    'Start in O14 on the Dest WS and loop down till column O is empty
    Do Until IsEmpty(ActiveCell.Value)


        TechName = ActiveCell.Value

        DestStart = ActiveCell.Address

            'Start in Cell A2 on the soure WS and search for tech from Dest WS
            For SCount = 2 To 700

                If SourceWS.Range("A" & SCount).Text = "Provisioning*" & _
                TechName & "*" Then
                'copy info from 2 offset cells from SourceWS to 2 offset cells on DestWS
                'I am offseting 4 columns to left on the DestWS just to see if they appear
                DestWS.Range(DestStart).Offset(0, -4).Value = SourceWS.Range(SourceWS.Range _
                ("A" & SCount).Address).Offset(3, 2).Text
                DestWS.Range(DestStart).Offset(-1, -4).Value = SourceWS.Range(SourceWS.Range _
                ("A" & SCount).Address).Offset(10, 2).Text

                End If

            Next SCount

        'Offset active cell on DestWS by 4 rows
        ActiveCell.Offset(4, 0).Activate
    Loop

    'Close SourceWB
    SourceWB.Close

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True


    Range("A1").Activate


End Sub

0 个答案:

没有答案