我有一个工作簿，我们在那里进行报价成本核算。有一个名为“成本计算表”的主要表格和可以具有不同名称的单个表格。所有工作表都具有相同的格式，First Row为Header。我只想要一个宏，它将在“成本计算表”中搜索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
答案 0 :(得分：0)
您的代码的目标似乎是在工作表“Master”中创建所有其他工作表的内容的副本。如果这是您所寻求的，那么此代码符合您的要求。我不明白用空列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