问题
I have been working at this problem for a while now. I have tried several different options, but each one ends up with a different error. As I stated in the title a type mismatch error. The basis for this macro is to move records from a master sheet to other sheets based on criteria from column F. The error occurs in the "Termination" case where it is selecting the cell "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
回答1:
There are a couple problems, first, you need to use the syntax Range("B2").Select to 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.
So, the entire case statement should look like this:
Case ThisValue = "Termination "
Sheets("Master").Cells(x, 2).EntireRow.Copy
Sheets("Terminations").Activate
Range("A2").Select
ActiveSheet.Paste
回答2:
There are a number of issues
- No need to
Select, use variables instead - Dim all your variables - help with debugging and learning
- Some general good practice techniques will help
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
回答3:
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 Range and 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.
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.
来源：https://stackoverflow.com/questions/8098576/vba-type-mismatch-error-when-trying-to-copy-paste-a-row-from-one-worksheet-to-a