excel - 在 VBA for Excel 中尝试基于变量将数据从一个 WB 复制到另一个

Question

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

下面是我试图运行的代码。它似乎运行没有错误（通过所有 FOR 和 Do Until 的），但只是没有将数据从源文件移动到目标文件。我使用的变量信息是从目标 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

标签： excelvba