基于另一个colunm中的数据将数据从一个Excel工作表上的行复制到另一个工作表

时间:2016-01-21 15:14:52

标签: excel vba excel-vba

如果M列中的相应行有(VR),我试图在excel中使用VBA来复制B列(名称)中的某些数据行。我也试图避免重复名称,除非第二次输入名称。从搜索网络,其他网站和朋友。我已经能够复制整个列,但不能过滤。当我运行宏时,我得到>"发生以下错误:错误#:1004。描述:Range类的AutoFilter方法失败。"如果我关闭过滤器,它会复制列b(名称)中的所有数据。如果第二次运行,它还会再次复制数据。我还在学习VBA&欢迎任何帮助。以下是当前代码:

Sub VOC_ASST()

Dim TargetSht As Worksheet, SourceSht As Worksheet, SourceCol As Integer, SourceCells As Range

'If an error occurs skip code to the Err-Hanlder line and the display the error message.
 On Error GoTo Err_Handler

'This is the sheet where your copy information from.
 Set SourceSht = ThisWorkbook.Sheets("Referrals")

'Name of the sheet where data is to be copied to.
 Set TargetSht = ThisWorkbook.Sheets("VOC_ASST")

'Sets the range to be filtered (e.g.B2-B65536) and filters for "VR" in the 13th colunm
 'SourceSht.Range("A1:A65536").AutoFilter Field:=13, Criteria1:="VR"

'This is the cells you will copy data from. This is targeting cells B1 to the last used cell in column B
 Set SourceCells = SourceSht.Range("B1:B" & SourceSht.Range("B65536").End(xlUp).Row)

'This is finding the next column available in the target sheet. It assumes dates will be in row 1 and data in row 2 down
 If TargetSht.Range("A1").Value = "" Then
     'Cell A1 is blank so the column to put data in will be column #1 (ie A)
     SourceCol = 1
 ElseIf TargetSht.Range("IV1").Value <> "" Then
     'Cell IV1 has something in it so we have reached the maximum number of columns we can use in this sheet.
     'Dont paste the data but advise the user.
     MsgBox "There are no more columns available in the sheet " & TargetSht.Name, vbCritical, "No More Data Can Be Copied"
     'stop the macro at this point
     Exit Sub
 Else
     'cell A1 does have data and we havent reached the last column yet so find the next available column
     SourceCol = TargetSht.Range("IV1").End(xlToLeft).Column + 1
 End If

'We can now start copying data. This will copy the cells in column B from the source sheet to row 2+ in the target sheet
 SourceCells.Copy TargetSht.Cells(2, SourceCol)

'Advise the user that the process was successful
 MsgBox "Data copied successfully!", vbInformation, "Process Complete"

Exit Sub 'This is to stop the procedure so we dont display the error message every time.
Err_Handler:      
    MsgBox "The following error occured:" & vbLf & "Error #: " & Err.Number & vbLf & "Description: " & Err.Description, _
         vbCritical, "An Error Has Occured", Err.HelpFile, Err.HelpContext

End Sub

附件是[在过滤器打印屏幕][1]

之前发生的事情的打印屏幕

附件是后过滤器打印屏幕。知道怎么纠正这个吗? After filter print Screen

0 个答案:

没有答案