Excel 基于名称有条件地将行复制到另一个工作簿

我正在尝试编写一个宏，该宏将根据客户名称将一行信息复制到该客户对应的工作簿中。例如，如果我有一个名为ABC Industries的客户，我希望它将该行复制到ABC Industries工作簿的新行中

---

谢谢

我会很慷慨，假设你不知道从哪里开始

通过查看过去两三个月的问题和答案，可以找到此答案中的所有信息。本网站上有很多相关信息，尤其是在标签

excelvba

下。如果你问一些小而具体的问题，证明你已经试过了，你会得到更好的答案

你的建议不是好的做法。您正在跨多个工作簿复制数据，我保证这些工作簿很快就会完全不同步

使用下面的代码，然后考虑链接工作簿，以便数据只显示一次。我还怀疑，如果您想要相同数据的不同视图，Access将是一个更好的工具

Option Explicit

Sub WriteToOtherWorkbook()

  Dim PathCrnt As String
  Dim RowNext As Long
  Dim WBookOther As Workbook
  Dim WBookOtherName As String

  ' I assume all workbooks are in the same folder at the active workbook
  PathCrnt = Application.ActiveWorkbook.Path

  If Workbooks.Count > 1 Then
    ' It is easy to get into a muddle if there are multiple workbooks
    ' open at the start of a macro like this.  Avoid the problem until
    ' you understand it.
    Call MsgBox("Please close all other workbooks", vbOKOnly)
    Exit Sub
  End If

  ' I assume you know how to find the name of the relevant workbook.
  WBookOtherName = "ABC Industries.xls"

  ' Open the named workbook      
  Set WBookOther = Workbooks.Open(PathCrnt & "\" & WBookOtherName)
  With WBookOther
    ' I assume you have some system for naming the sheets in the
    ' company workbooks.
    With .Sheets("XXXXXX")

      ' If you know that the last row will have a value in, for example,
      ' column "B" use this code which is the equivalent of going to
      ' the bottom of column "B", clicking Ctrl+Up to find the last
      ' cell with a value and then adding one to that value.
      RowNext = .Cells(Rows.Count, "B").End(xlUp).Row + 1

      ' If you are not sure which column of the last row is
      ' guaranteed to contain a value, use this code.
      RowNext = .Cells.SpecialCells(xlCellTypeLastCell).Row + 1

      ' Write some values to the row
      .Cells(RowNext, 1) = "A"
      .Cells(RowNext, 2) = "B"

    End With
    .Save       ' Save the changes
    .Close      ' Close the workbook
    Set WBookOther = Nothing    ' Clear reference to workbook
  End With

End Sub

此代码在工作表中查找特定名称

For InxWS = 1 To Worksheets.Count
  If Worksheets(InxWS).Name = "ABC Industries" Then
    Found = True
    Exit For
  EndIf
Next

If Found Then
  With Worksheets(InxWS)
    ' Add data
  End With
Else
  Call MsgBox("No worksheet for AC Industries",vbYesOK)
Endif

---

我希望这足以让你开始。正如我在开始时所说，在任何人能够提供比一般帮助更多的帮助之前，你需要更加具体。

你能发布你尝试过但没有奏效的东西吗？啊，我明白了。事实上我用错了词。我试图将信息放入适当的客户工作表中，而不是工作簿中。将数据复制到任何地方都不是一个好主意。对某人来说，更新一个副本而不是另一个副本非常容易。我希望你们的顾客不多。我使用过40张工作表的工作簿，它们很难导航。我相信理论上的限制是每个工作簿255张工作表。我没有使用我的原始代码，而是添加了一些查找工作表的代码。