vba 将一行从一个工作表复制/粘贴到另一个会产生类型不匹配错误

Copy/paste a row from one worksheet to another produces type mismatch error

提问by SCar88

This macro is to move records from a master sheet to other sheets based on criteria from column F.

此宏用于根据 F 列中的条件将记录从主表移动到其他表。

A type mismatch error occurs in the "Termination" case where it is selecting the cell "B2".

在选择单元格“B2”的“终止”情况下会发生类型不匹配错误。

I tried several different options, but each ends up with a different error.

我尝试了几个不同的选项，但每个选项都以不同的错误告终。

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

回答by PaulStock

There are a couple problems, first, you need to use the syntax Range("B2").Selectto select the cell. BUT, since you selected the entire row from the master sheet, you can't copy the entire row into B2, because the ranges aren't the same size, so you need to select the first cell (A2) instead.

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

So, the entire case statement should look like this:

因此，整个 case 语句应如下所示：

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

回答by chris neilsen

There are a number of issues

有很多问题

1. No need to Select, use variables instead
2. Dim all your variables - help with debugging and learning
3. Some general good practice techniques will help

1. 不需要Select，改用变量
2. 调暗所有变量 - 帮助调试和学习
3. 一些通用的良好实践技术将有所帮助

Here's a (partially) refactored version of your code

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

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

回答by Jon

This is what I basically use to do exactly what you are talking about. I have a "master" sheet that is several thousand rows and a couple hundred columns. This basic version only searches in Column Y and then copies rows. Because other people use this, though, I have several template worksheets that I keep very hidden so you can edit that out if you don't want to use templates. I also can add additional search variables if needed and simply adding in another couple of lines is easy enough. So if you wanted to copy rows that match two variables then you'd define another variable Dim d as Rangeand Set d = shtMaster.Range("A1")or whatever column you wanted to search the second variable. Then on the If line change it to If c.Value = "XXX" and d.Value = "YYY"Then . Finally make sure you add an offset for the new variable with the c.offset (so it would have a line Set d = d.Offset(1,0)at the bottom with the other). It really has turned out to be pretty flexible for me.

这就是我基本上用来做你正在谈论的事情的方法。我有一个几千行几百列的“主”表。此基本版本仅在 Y 列中搜索，然后复制行。但是，因为其他人使用它，所以我有几个模板工作表，我将它们非常隐藏，因此如果您不想使用模板，则可以对其进行编辑。如果需要，我还可以添加其他搜索变量，只需添加另外几行就足够容易了。因此，如果您想复制与两个变量匹配的行，那么您需要定义另一个变量Dim d as Range和/Set d = shtMaster.Range("A1")或您想要搜索第二个变量的任何列。然后在 If 行将其更改为If c.Value = "XXX" and d.Value = "YYY"Then 。最后确保使用 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

Also, if you wanted then you could remove the screenupdating lines. As stupid as it sounds some people actually like to see excel working at it. With screenupdating off you don't get to see the destination sheet until the copying is completed, but with updating on the screen flickers like crazy because of it trying to refresh when each row is copied. Some of the older people in my office think that excel is broken when they can't see it happening so I keep screenupdating on most of the time. lol Also, I like having the templates because all of my reports have quite a few formulas that need to be calculated after the information is broken down so I am able to keep all the formulas where I want them with a template. Then all I have to do is run the macro to pull from the master sheet and the report is ready to go without any further work.

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