Excel VBA 筛选列中的值并将信息复制到另一个工作簿中答案

【问题标题】：Excel VBA filter value in column and copy info into another workbookExcel VBA 筛选列中的值并将信息复制到另一个工作簿中
【发布时间】：2019-01-20 19:01:17
【问题描述】：

（忽略代码已被注释掉的事实）

我有一个工作簿（“BOM 模板”），里面有一张（“臭氧发生器滑轨”）。在该表上，我有一个从第 8 行开始的表格。每个表格行都有复选框。当这些复选框被选中然后单击一个按钮时，我希望打开另一个工作簿。该工作簿（“仪器数据表”）以某种方式格式化，其中包含一个名为“Temp_Datasheet”的格式的模板表。对于在原始工作簿的 C 列中输入的每个唯一“数据表名称”，必须在新工作簿中创建格式与 Temp_Datasheet 完全相同的工作表。具有相同“数据表名称”的所有“标签号”及其“处理位置”必须出现在新工作簿的同一张表上（标签号 1 将在 Temp_Datasheet 中出现 (2,3)，然后该标签号的处理位置将出现在（2,4）中。下一个标签号将出现在（2,5）等）

我可以打开模板 Temp_Datasheet，但仅此而已。该代码不会为每个唯一的数据表创建新表，也不会使用相应的信息填充表。请帮忙！

'Private Sub CommandButt_Click()              ' instrument data sheet
'
'Application.ScreenUpdating = False
'
'Dim CounterQTY, rowcounter, colcounter, lastcell, actcell, nextcell, cnt As Integer
'Dim MySheetName, TagNr As String
'Dim WS As Worksheet
'Dim CHK As Boolean
'Dim wbTarget As Workbook 'workbook where the data is to be pasted
'Dim wbThis As Workbook 'workbook from where the data is to copied
'Dim strName As String   'name of the source sheet/ target workbook
''On Error Resume Next
'
'
''***************************************************************************************
''search lastRow
''***************************************************************************************
'
'Dim LastCellA As Range
'Dim LastCellRowNumber As Long
'
'Set searchWS = Worksheets("Ozone Generator Skid")
'    With searchWS
'        Set LastCellB = .Cells(.rows.Count, "B").End(xlUp)
'        LastCellRowNumber = Application.WorksheetFunction.Max(LastCellB.Row)
'    End With
'
'
'
''***************************************************************************************
''create new sheet
''***************************************************************************************
'
''clear any thing on clipboard to maximize available memory
'Application.CutCopyMode = False
'
''set to the current active workbook (the source book)
'Set wbThis = ActiveWorkbook
'
''get the active sheetname of the book
'strName = ThisWorkbook.Path
'
''open a workbook that has same name as the sheet name (the workbook and the sheet inside it have the same name?) JK: now I think this is saying the file that will have all the valve data sheets in it (wbTarget) will have the name of the file that is being opened from the Vault link below (Ex: "Water Instrument Sheet") and inside that file "Water Instrument Sheet" in the Vault, the sheet name is called "Temp_Datasheet" and is invisible, waiting to become visible. I can just download a copy of a valve and instrument data sheet, move it to my Vault folder, rename the file however I want, and then paste the link here. And since "Temp_Datasheet" is already inside the data sheet file, I need not worry about anything except filling in the accurate ranges for the info below!
'
'Set wbTarget = Workbooks.Open("C:\Degremont Vault\ONA\Templates\Templates Activated by BOM\Instrument Data Sheet.xlsx")
'
''activate the source book
'wbThis.Activate
'
'For i = 8 To LastCellRowNumber
'
'    lastcell = Worksheets("Ozone Generator Skid").Cells(i - 1, 3).Value
'    actcell = Worksheets("Ozone Generator Skid").Cells(i, 3).Value
'
'        If actcell <> lastcell And Not (IsEmpty(actcell)) And Worksheets("Ozone Generator Skid").OLEObjects("CHK" & i).Object.Value = True Then
'
'        rowcounter = 2                                                          ' reset tag field
'        colcounter = 3
'        CounterQTY = 1
'
'        MySheetName = Worksheets("Ozone Generator Skid").Cells(i, 3).Text
'
'        wbTarget.Activate
'            For Each WS In wbTarget.Worksheets
'                Worksheets("Temp_Datasheet").Visible = True
'                If InStr(WS.Name, MySheetName) = 1 Then
'                    CHK = True
'                    cnt = cnt + 1
'                End If
'            Next
'
'            If CHK Then
'                Sheets("Temp_Datasheet").Select                                       ' create new sheet if sheet already exist
'                Sheets("Temp_Datasheet").Copy After:=Worksheets(Worksheets.Count)
'                ActiveSheet.Name = MySheetName & "_" & cnt
'                ActiveSheet.Unprotect
'            Else
'                Sheets("Temp_Datasheet").Select                                        ' create new sheet
'                Sheets("Temp_Datasheet").Copy After:=Worksheets(Worksheets.Count)
'                ActiveSheet.Name = MySheetName
'                ActiveSheet.Unprotect
'            End If
'        Worksheets("Temp_Datasheet").Visible = False
'
'
''***************************************************************************************
''copy and paste specific cells to new sheet
''***************************************************************************************
'        ActiveSheet.Range("C11").Value = wbThis.Worksheets("Ozone Generator Skid").Cells(i, 8).Value          ' MM#
'        ActiveSheet.Range("C2").Value = wbThis.Worksheets("Ozone Generator Skid").Cells(i, 4).Value           ' Tag #
'        ActiveSheet.Range("C1").Value = wbThis.Worksheets("Ozone Generator Skid").Cells(i, 32).Value           ' Material Description
'        ActiveSheet.Range("C12").Value = wbThis.Worksheets("Ozone Generator Skid").Cells(i, 20).Value          ' Manufacturer
'        ActiveSheet.Range("C13").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 19).Value          ' Model #
'        ActiveSheet.Range("D2").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 4).Value           ' Process Location
'        ActiveSheet.Range("C14").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 17).Value          ' Material/Body Material
'        ActiveSheet.Range("C15").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 18).Value         ' Connection
'        ActiveSheet.Range("C16").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 27).Value         ' Power
'        ActiveSheet.Range("C17").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 26).Value         ' Instrument Range
'        ActiveSheet.Range("C18").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 30).Value         ' Design Range
'        ActiveSheet.Range("F18").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 28).Value         ' Alarm
'        ActiveSheet.Range("H18").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 29).Value         ' Interlock
'        ActiveSheet.Range("C19").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 31).Value         ' Options on the Data Sheet corresponds to Oxygen Cleaned from the BOM
'        ActiveSheet.Range("C25").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 34).Value         ' Notes
'        ActiveSheet.Range("C10").Value = 1
'
''***************************************************************************************
''copy and paste information from header to new sheet
''***************************************************************************************
'        ActiveSheet.Range("A28").Value = wbThis.Worksheets("Ozone Generator Skid ").Range("AB5").Value   ' Issued
'        ActiveSheet.Range("A30").Value = wbThis.Worksheets("Ozone Generator Skid ").Range("AD5").Value   ' checked
'        ActiveSheet.Range("A32").Value = wbThis.Worksheets("Ozone Generator Skid ").Range("AF5").Value   ' approved
'        ActiveSheet.Range("C27").Value = wbThis.Worksheets("Ozone Generator Skid ").Range("N2").Value   ' project name
'        ActiveSheet.Range("C29").Value = wbThis.Worksheets("Ozone Generator Skid ").Range("N3").Value   ' project #
'        ActiveSheet.Range("H31").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 35).Value  ' Rev
'        ActiveSheet.Range("F30").Value = wbThis.Worksheets("Ozone Generator Skid ").Cells(i, 3).Value   ' Sheet #
'
'        End If
'
''***************************************************************************************
''copy and paste only Tag # to same specsheet
''***************************************************************************************
'    wbThis.Activate
'
'    If actcell = lastcell And Not (IsEmpty(actcell)) And Worksheets("Ozone Generator Skid").OLEObjects("CHK" & i).Object.Value = True Then
'        colcounter = colcounter + 2
'            If colcounter > 8 Then
'                colcounter = 3
'                rowcounter = rowcounter + 1
'            End If
'        wbTarget.Worksheets(MySheetName).Cells(rowcounter, colcounter).Value = wbThis.Worksheets("Ozone Generator Skid").Cells(i, 4).Value ' Tag #
'        wbTarget.Worksheets(MySheetName).Cells(rowcounter, colcounter + 1).Value = wbThis.Worksheets("Ozone Generator Skid").Cells(i, 8).Value ' Process Location
'        CounterQTY = CounterQTY + 1
'        wbTarget.Worksheets(MySheetName).Range("C10").Value = CounterQTY
'
'    End If
'
'Next i
'
'
'wbThis.Activate
'Application.ScreenUpdating = True
'
''Clear memory
'Set wbTarget = Nothing
'Set wbThis = Nothing
'
'
'End Sub

【问题讨论】：

对于初学者，请删除On Error Resume Next，它会在您真正应该处理错误时默默地隐藏它们。会出现什么错误？另外，您有wbThis，但随后使用ThisWorkbook - 它们是一回事吗？
On Error Resume Next 在我使用代码时被注释掉（''不仅仅是'）。我认为问题发生在 Worksheets("Temp_Datasheet").Visible = False 之前，但它告诉我 wbTarget.Worksheets(MySheetName).Cells(rowcounter, colcounter).Value = wbThis.Worksheets("Ozone Generator Skid").Cells(i, 4).Value ' Tag #
我相信一切都已正确命名，所以我看不到“下标超出范围适用”错误。而且我相信在那之前有一个错误，因为在 Worksheets("Temp_Datasheet").Visible = False 应该创建另一个工作表但是当我运行代码时，情况并非如此（没有创建其他工作表，只有 Temp_Datasheet可见）

标签： excel vba filter copy-paste

【解决方案1】：

从这一行可以看出您有两个主要问题：

wbTarget.Worksheets(MySheetName).Cells(rowcounter, colcounter).Value = wbThis.Worksheets("Ozone Generator Skid").Cells(i, 4).Value ' Tag #

1) 您的新工作表无法被识别。这可能是范围问题，但解决它的一种简单方法是通过在该行之前添加这两行代码来实际添加该新工作表：

MySheetName = wbThis.Worksheets("Ozone Generator Skid").Cells(i, 3).Text
wbTarget.Worksheets.Add(After:=wbTarget.Worksheets(wbTarget.Worksheets.Count)).Name = MySheetName

2) 即使你这样做了，你的范围是关闭的，因为在同一行中，rowcounter 实际上是未定义的。要解决此问题，您可以将 rowcounter、colcounter 和 CounterQTY 声明移到 if 语句之前，如下所示：

For i = 8 To LastCellRowNumber

    lastcell = Worksheets("Ozone Generator Skid").Cells(i - 1, 3).Value
    actcell = Worksheets("Ozone Generator Skid").Cells(i, 3).Value

        rowcounter = 2                                                          ' reset tag field
        colcounter = 3
        CounterQTY = 1

        If actcell <> lastcell And Not (IsEmpty(actcell)) And Worksheets("Ozone Generator Skid").OLEObjects("CHK" & i).Object.Value
= True Then

之后，只需更新代码以匹配模板并处理边缘情况和错误检查，您就应该进行填充！

【讨论】：