Question

我正在尝试将特定单元格的内容从一个工作簿（MRP）复制到另一个工作簿（计划模板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）复制到以6开始并递增的counterX位置的单元格wsDest（计划模板2）。预先谢谢你。

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

如何将单元格内容从一个工作簿复制到另一个工作簿？

1 个答案: