时间戳

首页 > 解决方案 > 如何将单元格内容从一个工作簿复制到另一个工作簿？

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

问题描述

我正在尝试将特定单元格的内容从一个工作簿（MRP）复制到另一个（计划模板 2）。两者都有不同的地址，只有当它在不同的列中找到单词 Schedule 时才应该复制它。

我试过下面的代码

模块一：

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 位置的单元格 i wsDest(Schedule Template 2)。先感谢您。

标签： excelvba

解决方案

这是我用于几乎所有内容的模板，它还允许您在需要时选择多个文件，并循环浏览您选择的每个文件。

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

推荐阅读