How to copy cell content from one workbook to another?

Question

I am trying to copy the content of a specific cell from one workbook(MRP) to the other(Schedule Template 2). Both have different addresses and it should only copy it when it finds the word Schedule in a different column.

I have tried the following code

Module 1:

Sub BAUMER1()

    Dim x As String

    'Activate Worksheet'
    ActiveWorkbook.Worksheets("MRP").Activate
    'Select first line of date'
    Worksheets("MRP").Range("Z3").Select

    'Set search variable'
    x = "BAUMER 1"

    'Set Do loop to stop at empty cell'
    Do Until IsEmpty(ActiveCell)
        'Check active cell for search value.'
        If ActiveCell.Value = x Then
            Call FindSchedule("BAUMER.(1)")
            Exit Do
        End If
        'Step down 1 row from present location.'
        ActiveCell.Offset(1, 0).Select
    Loop

End Sub

Sub LIBERTY1()

    Dim x As String
    ActiveWorkbook.Worksheets("MRP").Activate
    'Select first line of date'
    Worksheets("MRP").Range("Z3").Select

    'Set search variable'
    x = "LIBERTY 1"

    'Set Do loop to stop at empty cell'
    Do Until IsEmpty(ActiveCell)
      'Check active cell for search value.'
      If ActiveCell.Value = x Then
          Call FindSchedule("LIBERTY.(1)")
          Exit Do
      End If
      'Step down 1 row from present location.'
      ActiveCell.Offset(1, 0).Select
    Loop

End Sub

Module 2:

Sub FindSchedule(machine As String)

    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet

    Dim x As String
    Dim a As Integer
    Dim found As Boolean
    Dim countX As Integer
    Dim machine2 As String
    machine2 = machine

    countX = 6
    Set wsCopy = Workbooks("MRP 6-13-2019.xlsm").Worksheets("MRP")
    Set wsDest = Workbooks("Schedule Template 2.xlsm").Worksheets(machine2)

    ActiveWorkbook.Worksheets("MRP").Activate
    ' Select first line of data.
    Worksheets("MRP").Range("G2").Select
    ' Set search variable value.
     x = "Schedule"
    'Set Do loop to stop at empty cell'
    Do Until IsEmpty(ActiveCell)
      'Check active cell for search value.'
      If ActiveCell.Value = x Then
          a = ActiveCell.Row
          Exit Do

      End If
      wsCopy.Cells("a,1").Copy
      wsDest.Cells("countX,5").PasteSpecial Paste:=xlPasteValues
      countX = countX + 1
      'Step down 1 row from present location.'
      ActiveCell.Offset(1, 0).Select
    Loop
End Sub

I need to copy the contents of a cell from wsCopy(MRP) at position row of active cell and first column to a cell i wsDest(Schedule Template 2) at position of counterX that begins at 6 and increments. Thank you in advance.

Answer 1

This is a template that I use for just about everything, it also allows you to select multiple files if need be, and loops through each file you selected.

Private Sub Import()

    Dim fd As FileDialog
    Dim FileChosen As Integer
    Dim tempWB As Workbook
    Dim i As Integer

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    fd.InitialFileName = "C:\"  #'Change this area to whatever folder you want
    fd.InitialView = msoFileDialogViewList
    fd.AllowMultiSelect = True

    FileChosen = fd.Show
    If FileChosen = -1 Then

        For i = 1 To fd.SelectedItems.Count

            Set tempWB = Workbooks.Open(fd.SelectedItems(i))

            #'Copy over your data here

            tempWB.Close False
            Set tempWB = Nothing

        Next i

    Else:
        Exit Sub

    End If

End Sub