VBA代码将所有工作表合并到除第一个工作表之外的1个工作表中
我有一个运行良好的代码，它结合了工作簿中所有工作表的数据。 但是，我需要从代码中排除Workbook.Sheets(1) ，但是尽pipe将代码从第二张开始更改，但仍将所有工作表组合在一起。 我的代码粘贴在下面。
我包括一个if语句，如果表格名称中包含“ Week ”，则执行命令，但导致代码的这部分根本不会发生。
For Each sht In wrk.Worksheets If LCase(sht.Name) = "Week" Then '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 'This above portion is the one i am referring to
我的代码是：
Sub CopyFromWorksheets() Dim wrk As Workbook 'Workbook object - Always good to work with object variables Dim sht As Worksheet 'Object for handling worksheets in loop Dim trg As Worksheet 'Master Worksheet Dim rng As Range 'Range object Dim colCount As Integer 'Column count in tables in the worksheets Set wrk = ActiveWorkbook 'Working in active workbook Set sht = wrk.Sheets(2) 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 'We don't want screen updating Application.ScreenUpdating = False 'Add new worksheet as the last worksheet 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.Sheets(2) 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 LCase(sht.Name) = "Week" Then '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.Value End If Next sht 'Fit the columns in Master worksheet trg.Columns.AutoFit 'Screen updating should be activated Application.ScreenUpdating = True End Sub
我想你忘了在以下情况下的敏感度：
If (LCase(sht.Name) = "Week") Then
LCase(sht.Name) = "Week"将始终为False ，因为：
LCase("Week") = "week" '--> True LCase("Week") = "Week" '--> False
所以，使用：
If (LCase(sht.Name) = "week") Then
要么
If (LCase(sht.Name) = LCase("Week")) Then
而包含或包含“星期”使用Like运算符而不是=这样：
If (LCase(sht.Name) Like "*" & LCase("Week") & "*" ) Then