我正在尝试将数据从一个大型工作簿(每月下载一次)编译为一个更简洁的数据。我每个月都会获取新数据。我将知道源文件的名称及其位置。
下面是我要运行的代码。它似乎可以正常运行(遍历所有的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