0

I am trying to compile data from one large workbook (that will be downloaded once a month) to one that is more concise. I will be pulling in new data every month. I will know the name of the source file and it's location.

Below is the code I am trying to run. It appears to run without errors (going thru all the FOR's and Do Until's) but is just not moving the data from the source file to the destination file. The variable information I am using is column O starting on line 14 of the destination WB. I am trying to sort thru column A of the source WB for some text and the variable from the destination WB. If I have a match I am trying to offset from the matching cell (down 3 rows and right 2 columns) and copy that information to an offset cell on the destination WB (left 4 columns on the same row). Also copying from down 10 rows and right 2 columns on the source to down row 1 and left 4 columns on the destination.

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
cybernetic.nomad
  • 6,100
  • 3
  • 18
  • 31
Jon
  • 1
  • I don't know but your problem may arise from your use of `ActiveCell`. This is dicey as can end up being something unexpected, particularly when you are using multiple workbooks. Set a reference to O14 at the beginning fully qualifying with workbook and sheet and refer to that rather than `ActiveCell`. – SJR Apr 17 '19 at 18:49
  • (1) you should try to modify your code so it doesn't rely on `ActiveCell` (2) Use `Like` if you want to use wildcards (3) `SourceWS.Range(SourceWS.Range ("A" & SCount).Address).Offset(3, 2).Text` is the same as `SourceWS.Cells(SCount+3, 3).Text` – Tim Williams Apr 17 '19 at 18:50
  • [How to avoid using Select/Activate](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) – Mathieu Guindon Apr 17 '19 at 19:51

0 Answers0