Question

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

由于

Answer 1

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

通过查看过去两三个月的问题和答案，可以找到本答案中的所有信息。此网站上有大量相关信息，特别是在excel-vba标记下。如果你提出一些证明你已经尝试的小问题，你会得到更好的答案。

你提出的建议不是好的做法。您正在复制多个工作簿中的数据，并且保证工作簿很快就会无可救药地失去作用。

使用下面的代码，然后考虑链接工作簿，以便数据只出现一次。我还怀疑如果你想要相同数据的非常不同的视图，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

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

有条件地根据名称将行复制到另一个工作簿

1 个答案: