Excel 将带有公式的行复制到主工作表

我有一本我们报价成本计算的手册。有一个名为“成本核算表”的主表和可以有不同名称的单独表。所有图纸的格式都相同，第一行作为标题。我只需要一个宏，它将搜索“成本计算表”中a列中的值，并与其他表的a列中的值进行比较，如果找到，则将整个a:W行从具有公式和格式的单个表复制到“成本计算表”，并与匹配的值进行比较。我创建了一个宏，可以复制所有数据并创建一个新的工作表。但这并没有给我想要的输出。我已经搜索了好几个论坛，但找不到相同的。如果你能帮忙的话，那将是很大的帮助。这是我用来创建新工作表的代码

Sub CopyFromWorksheets()
Dim wrk As Workbook 
Dim sht As Worksheet 
Dim trg As Worksheet 
Dim rng As Range 
Dim colCount As Integer 
Set wrk = ActiveWorkbook 

For Each sht In wrk.Worksheets
    If sht.Name = "Master" Then
        MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
        "Please remove or rename this worksheet since 'Master' would be" & _
        "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
        Exit Sub
    End If
Next sht


Application.ScreenUpdating = False


Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
 'Rename the new worksheet
trg.Name = "Master"
 'Get column headers from the first worksheet
 'Column count first
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
 'Now retrieve headers, no copy&paste needed
With trg.Cells(1, 1).Resize(1, colCount)
    .Value = sht.Cells(1, 1).Resize(1, colCount).Value
     'Set font as bold
    .Font.Bold = True
End With

 'We can start loop
For Each sht In wrk.Worksheets
     'If worksheet in loop is the last one, stop execution (it is Master worksheet)
    If sht.Index = wrk.Worksheets.Count Then
        Exit For
    End If
     'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
    Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
     'Put data into the Master worksheet
    trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Formula
Next sht
 'Fit the columns in Master worksheet
trg.Columns.AutoFit
 Sheets("Master").Select
colCount = Range("A" & Rows.Count).End(xlUp).Row

Range("L2:L" & colCount).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 'Screen updating should be activated
Application.ScreenUpdating = True

Sheets("Costing Sheet").Select
End Sub

---

代码的目标似乎是创建工作表“主”中所有其他工作表内容的副本。如果这是您所寻求的，那么此代码满足您的要求。我不理解删除任何带有空列L的行的代码，只是将其注释掉了

Option Explicit
Sub CopyFromWorksheets()

  Dim sht As Worksheet
  Dim trg As Worksheet
  Dim rng As Range
  ' ## Long matches the natural size of an integer on a 32-bit computer.
  ' ## A 16-bit Integer variable is, I am told, slightly slower in execution.
  Dim colCount As Long
  Dim rowCount As Long    ' ## Added by me.  See later.
  Dim rowTrgNext As Long  ' ## Added by me.  See later.

  ' ## The active workbook is the default workbook.  You can have several
  ' ## workbooks open and move data between them.  If you were doing this
  ' ## then identifying the required workbook would be necessary.  In your
  ' ## situation wrk has no value.  You could argue it does no harm but I
  ' ## dislike extra, unnecessary characters because I believe they make the
  ' ## code harder to understand.  I have remove all references to wrk.

  For Each sht In Worksheets
    If sht.Name = "Master" Then
      MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
             "Please remove or rename this worksheet since 'Master' would be " & _
             "the name of the result worksheet of this process.", _
             vbOKOnly + vbExclamation, "Error"
             Exit Sub
    End If
  Next sht

  'Application.ScreenUpdating = False
  Set trg = Worksheets.Add(After:=Worksheets(Worksheets.Count))
  'Rename the new worksheet
  trg.Name = "Master"
  'Get column headers from the first worksheet
  'Column count first
  Set sht = Worksheets(1)
  ' ## 255 is the maximum number of columns for Excel 2003.
  ' ## Columns.Count gives the maximum number of columns for any version.
  colCount = sht.Cells(1, Columns.Count).End(xlToLeft).Column
  'Now retrieve headers, no copy&paste needed
  ' ## Excel VBA provides alternative ways of achieving the same result.
  ' ## No doubt this is an accident of history but it is considered poor
  ' ## language design.  I avoid Resize and Offset (which you use later)
  ' ## because I find the resultant statements difficult to get right in
  ' ## the first place and difficult to understand when I need to update
  ' ## the code six or twelve months later.  I find .Range("Xn:Ym") or
  ' ## .Range(.Cells(n, "X"),.Cells(m, "Y")) easier to get right and
  ' ## easier to understand.  I am not asking you to agree with me; I am
  ' ## asking to consider what you would find easiest to get right and
  ' ## easiest to understand when you look at this code in six months.
  ' ## I have changed your code to show you the approach I prefer.
  Set rng = sht.Range(sht.Cells(1, 1), sht.Cells(1, colCount))
  With trg
    With .Range(.Cells(1, 1), .Cells(1, colCount))
      .Value = rng.Value
      'Set font as bold
      .Font.Bold = True
    End With
  End With
  rowTrgNext = 2    ' ## See later

  'We can start loop
  For Each sht In Worksheets
    'If worksheet in loop is the last one, stop execution
    ' (it is Master worksheet)
    ' ## I would favour
    ' ##    If sht.Name = "Master" Then
    ' ## because  think it is clearer.
    If sht.Index = Worksheets.Count Then
      Exit For
    End If
    ' ## 1) 65536 is the maximum number of rows for Excel 2003.
    ' ##    Rows.Count gives the maximum number of rows for any version.
    ' ## 2) As explained earlier, I do not like Resize or Offset.
    ' ## 3) I avoid doing more than one thing per statement if it means
    ' ##    I have to think hard about what is being achieved.
    ' ## 4) Rather than use End(xlUp) to determine the last unused row in
    ' ##    worksheet Master, I maintain the value in rowTgtNext.
    'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
    With sht
      ' ## Are you sure column A is full on every sheet
      ' ## This returns the last row used regardless of column
      rowCount = .Cells.SpecialCells(xlCellTypeLastCell).Row
      Set rng = sht.Range(.Cells(2, 1), .Cells(rowCount, colCount))
    End With
    'Put data into the Master worksheet
    ' ## This copies everything: formulae, formats, etc.
    rng.Copy Destination:=trg.Range("A" & rowTrgNext)
    rowTrgNext = rowTrgNext + rowCount - 1
  Next sht
  'Fit the columns in Master worksheet
  trg.Columns.AutoFit

  ' ## I do not know what this is trying to achieve.
  ' ## It will delete any row that does not have a value in column L
  ' ## providing at least one cell in column L does contain a value.
  'Sheets("Master").Select
  'colCount = Range("A" & Rows.Count).End(xlUp).Row
  'Range("L2:L" & colCount).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  'Screen updating should be activated

  Application.ScreenUpdating = True
  Sheets("Costing Sheet").Select

End Sub

---

你好，托尼·达利莫尔先生，谢谢你的回复。每个单独的图纸底部都有该图纸的总计算。当我运行此宏时，所有数据都将传输到母版图纸。但是我不需要在主表摘要中包含这些单独的表。因此，我只想避免根据空白L列的标准复制到主控表的单个工作表总计。但其中也有一些实际问题。我只需要一个宏，它可以根据主工作表a列中的值将整行从单个工作表复制到主工作表。对于我的答案，我试图改进您的代码，但我没有添加任何内容。在您的原始代码中没有任何内容可以对照工作表“成本计算表”检查值，因此它不在我的版本中。我已经更仔细地阅读了你的问题，你寻找的代码不仅仅是一个正确的版本。您在“成本计算表”中搜索哪些值？您将它们与其他表格中的值进行比较？哪些行复制到“Master”中？我将指出可能更容易理解的基础1。成本表是主表，我们遵循一个模板。它是所有供应商产品的汇总。列A是产品的唯一数字代码。B列为供应商名称。C列项目说明。D列单位、E列单位成本和其他列是基于公式的计算。我会在成本表的A、B、C、D和E栏中输入详细信息。2.然后，我制作了一份成本表的副本，并根据B列中给出的供应商信息对其进行重命名。因此，为每个供应商制作单独的成本表，并删除其余的成本表。然后在每个供应商表中根据其货币进行计算，运费等。这就是为什么要为每个供应商制作单独的表，因为每个供应商的表都不同。4.稍后，我只想根据A列以及各个表中使用的公式，将各个供应商表中的行复制并粘贴到成本表中