Как скопировать содержимое ячейки из одной рабочей книги в другую?

Question

Я пытаюсь скопировать содержимое определенной ячейки из одной рабочей книги (ППМ) в другую (шаблон расписания 2). Оба имеют разные адреса, и он должен копировать его только тогда, когда он находит слово «Расписание» в другом столбце.

Я попробовал следующий код

Модуль 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

Модуль 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

Мне нужно скопировать содержимое ячейки из wsCopy (MRP) в строке позиции активной ячейки и первого столбца в ячейку i wsDest (шаблон расписания 2) в позиции counterX, которая начинается с 6 и увеличивается. Заранее спасибо.

Answer 1

Это шаблон, который я использую практически для всего, он также позволяет вам выбрать несколько файлов, если это необходимо, и циклически перебирает каждый выбранный вами файл.

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