Question

我已经在这个问题上工作了一段时间了。我尝试了几种不同的选项，但每种选项都会出现不同的错误。正如我在标题中所说的类型不匹配错误。此宏的基础是根据列F中的条件将记录从主表单移动到其他表单。错误发生在“终止”情况下，它选择单元格“B2”。

Public Sub moveToSheet()


Sheets("Master").Select
' Find the last row of data
FinalRow = Range("E65000").End(xlUp).Row
'Loop through each row
For x = 2 To FinalRow
    ' Decide where to copy based on column F
    ThisValue = Range("F" & x).Value

    Select Case True

    Case ThisValue = "Hiring "
        Sheets("Master").Cells(x, 2).EntireRow.Copy
        Sheets("Hiring").Select
        Sheets("Hiring").Range("B2:W2500").Clear
        Sheets("Hiring").Cells("B2").Select
        ActiveSheet.Paste
        Sheets("Master").Select
    Case ThisValue = "Re-Hiring "
        Sheets("Master").Cells(x, 2).EntireRow.Copy
        Sheets("Hiring").Select
        Sheets("Hiring").Range("B2:W2500").Clear
        Sheets("Hiring").Cells("B2").Select
        ActiveSheet.Paste
    Case ThisValue = "Termination "
        Sheets("Master").Cells(x, 2).EntireRow.Copy
        Sheets("Terminations").Select
        Sheets("Terminations").Range("B2:W2500").Clear
        Sheets("Terminations").Cells("B2").Select
        ActiveSheet.Paste
    Case ThisValue = "Transfer "
        Sheets("Master").Cells(x, 2).EntireRow.Copy
        Sheets("Transfers").Select
        Sheets("Transfers").Range("B2:W2500").Clear
        Sheets("Transfers").Cells("B2").Select
        ActiveSheet.Paste
    Case ThisValue = "Name Change "
        Sheets("Master").Cells(x, 2).EntireRow.Copy
        Sheets("Name Changes").Select
        Sheets("Name Changes").Range("B2:W2500").Clear
        Sheets("Name Changes").Cells("B2").Select
        ActiveSheet.Paste
    Case ThisValue = "Address Change "
        Sheets("Master").Cells(x, 2).EntireRow.Copy
        Sheets("Address Changes").Select
        Sheets("Address Changes").Range("B2:W2500").Clear
        Sheets("Address Changes").Cells("B2").Select
        ActiveSheet.Paste
    Case Else
        Sheets("Master").Cells(x, 2).EntireRow.Copy
        Sheets("New Process").Select
        Sheets("New Process").Range("B2:W2500").Clear
        Sheets("New Process").Cells("B2").Select
        ActiveSheet.Paste
    End Select

Next x

End Sub

Answer 1

有几个问题，首先，您需要使用语法Range("B2").Select来选择单元格。但是，因为您从主工作表中选择了整行，所以无法将整行复制到B2中，因为范围大小不同，因此您需要选择第一个单元格（ A2）而不是。

因此，整个案例陈述应如下所示：

 Case ThisValue = "Termination "
        Sheets("Master").Cells(x, 2).EntireRow.Copy
        Sheets("Terminations").Activate
        Range("A2").Select
        ActiveSheet.Paste

Answer 2

有很多问题

无需Select，而是使用变量
调暗所有变量 - 帮助调试和学习
一些一般的良好实践技巧将有所帮助

这是您的代码的（部分）重构版本

Public Sub moveToSheet()
    Dim wb As Workbook
    Dim shMaster As Worksheet, shHiring As Worksheet
    Dim rngMaster As Range
    Dim x As Long
    Dim rw As Range

    Set wb = ActiveWorkbook
    Set shMaster = wb.Worksheets("Master")
    Set shHiring = wb.Worksheets("Hiring")
    ' etc

    ' Find the data
    x = shMaster.UsedRange.Count  ' trick to reset used range
    Set rngMaster = shMaster.UsedRange
    'Loop through each row  NOTE looping thru cells is SLOW.  There are faster ways
    For Each rw In rngMaster.Rows
        ' Decide where to copy based on column F
        Select Case Trim$(rw.Cells(1, 6).Value)  ' Is there really a space on the end?
            Case "Hiring"
                shHiring.[B2:W2500].Clear
                rw.Copy shHiring.[B2]
'            Case ' etc
        End Select
    Next rw

Answer 3

这是我基本上用来做你正在谈论的内容。我有一个“主”表，有几千行和几百列。此基本版本仅在列Y中搜索，然后复制行。但是，因为其他人使用它，我有几个模板工作表，我一直非常隐藏，所以如果你不想使用模板，你可以编辑它。如果需要，我还可以添加其他搜索变量，只需添加另外两行就足够了。因此，如果要复制与两个变量匹配的行，则需要定义另一个变量Dim d as Range和Set d = shtMaster.Range("A1")或您要搜索第二个变量的任何列。然后在If行上将其更改为If c.Value = "XXX" and d.Value = "YYY"然后。最后确保使用c.offset为新变量添加偏移量（因此底部的行Set d = d.Offset(1,0)与另一行）。事实证明，这对我来说非常灵活。

Sub CreateDeptReport(Extras As String)

    Dim shtRpt As Excel.Worksheet, shtMaster As Excel.Worksheet
    Dim LCopyToRow As Long
    Dim LCopyToCol As Long
    Dim arrColsToCopy
    Dim c As Range, x As Integer

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    On Error GoTo Err_Execute

    arrColsToCopy = Array(1, 3, 4, 8, 25, 25, 21, 16, 17, 15, 31, 7) 'which columns to copy ?

    Set shtMaster = ThisWorkbook.Sheets("MasterSheet")
    Set c = shtMaster.Range("Y5")  'Start search in Column Y, Row 5

    LCopyToRow = 10 'Start copying data to row 10 in Destination Sheet

    While Len(c.Value) > 0
        'If value in column Y equals defined value, copy to destination sheet
        If c.Value = “XXX” Then

            'only create the new sheet if any records are found
            If shtRpt Is Nothing Then
                'delete any existing sheet
                On Error Resume Next
                ThisWorkbook.Sheets("Destination").Delete
                On Error GoTo 0
                ThisWorkbook.Sheets("Template").Visible = xlSheetVisible
                ThisWorkbook.Sheets("Template").Copy After:=shtMaster
                Set shtRpt = ThisWorkbook.Sheets(shtMaster.Index + 1)
                shtRpt.Name = "Destination" 'rename new sheet to Destination
    ‘Optional Information; can edit the next three lines out - 
                Range("F1").Value = "Department Name"
                Range("F2").Value = "Department Head Name"
                Range("B3").Value = Date
                ThisWorkbook.Sheets("Template").Visible = xlSheetVeryHidden
            End If

            LCopyToCol = 1

            shtRpt.Cells(LCopyToRow, LCopyToCol).EntireRow.Insert shift:=xlDown

            For x = LBound(arrColsToCopy) To UBound(arrColsToCopy)

                shtRpt.Cells(LCopyToRow, LCopyToCol).Value = _
                            c.EntireRow.Cells(arrColsToCopy(x)).Value

                LCopyToCol = LCopyToCol + 1

            Next x            
            LCopyToRow = LCopyToRow + 1 'next row
        End If
        Set c = c.Offset(1, 0)
    Wend

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    Range("A9").Select 'Position on cell A9
    MsgBox "All matching data has been copied."
    Exit Sub

Err_Execute:
        MsgBox "An error occurred."
End Sub

此外，如果您需要，则可以删除屏幕更新行。听起来很愚蠢，有些人实际上喜欢看excel工作。随着屏幕更新关闭，您无法在复制完成之前看到目标表单，但屏幕上的更新会像疯狂一样闪烁，因为它会在每行复制时尝试刷新。我办公室里的一些老人认为，当他们看不到它时，excel就会被打破，所以我大部分时间都会进行屏幕更新。大声笑此外，我喜欢使用模板，因为我的所有报告都有相当多的公式需要在信息被分解后计算，所以我能够将所有公式保存在我想要的模板中。然后，我所要做的就是运行宏从主表单中提取，报表已经准备就绪，无需任何进一步的工作。

尝试将行从一个工作表复制/粘贴到另一个工作表时，VBA-类型不匹配错误。提供的代码

3 个答案: