Range类的复制方法失败

时间:2017-03-28 23:26:55

标签: excel-vba vba excel

我正在尝试执行以下VBA:

1.将包含wsReplen的“G”列数据和wsFormstack的列“D”的数据合并到ws6的列“B”中。

2.仅将ws6的“B”列中的唯一单元格值复制并粘贴到ws6的“C”列中。

代码运行正常,直到我尝试添加唯一值代码。它给出运行时错误'1004'“Range类的复制方法失败”。我尝试在单独的模块中运行唯一值代码,并删除了工作簿的所有以前的副本,但似乎没有解决问题。

这里的代码有问题:

  wsReplen.Range("G2", wsReplen.Cells(finalRowReplen, "G")).Copy               
  Destination:=ws6.Range("B" & finalRow6)    

代码如下:

Option Explicit

Sub CombineColumns()

Dim finalRow6 As Integer
Dim finalRowReplen As Integer
Dim finalRowFormStack As Integer

Dim ws6 As Excel.Worksheet: Set ws6 = Sheets("Sheet6")
Dim wsReplen As Excel.Worksheet: Set wsReplen = Sheets("ReplenData")
Dim wsFormStack As Excel.Worksheet: Set wsFormStack = Sheets("Formstack")

' set column headers
ws6.Range("A1").Value = "Employee"
ws6.Range("B1").Value = "Pallet Number"
ws6.Range("C1").Value = "Unique Values"
ws6.Range("D1").Value = "Reason"

' set column header green
ws6.Activate
ws6.Range("A1:D1").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 5287936
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

' set column autofit
ws6.Columns("A:D").EntireColumn.AutoFit

' get last row of G in ReplenData
finalRowReplen = wsReplen.Cells(wsReplen.Rows.Count, "G").End(xlUp).Row

' get last row of 6 to paste into
finalRow6 = ws6.Cells(ws6.Rows.Count, "B").End(xlUp).Row + 1

'copy ReplenData->Pallet Number into 6
wsReplen.Range("G2", wsReplen.Cells(finalRowReplen, "G")).Copy _              
& Destination:=ws6.Range("B" & finalRow6)

' get last row of D in FormStack
finalRowFormStack = wsFormStack.Cells(wsFormStack.Rows.Count, _     
& "D").End(xlUp).Row

' get last row of 6 to paste into
finalRow6 = ws6.Cells(ws6.Rows.Count, "B").End(xlUp).Row + 1 

' copy FormStack->Pallet Id into 6 
wsFormStack.Range("D2", wsFormStack.Cells(finalRowFormStack, "D")).Copy _           
& Destination:=ws6.Range("B" & finalRow6)

ws6.Range("B2:B999").AdvancedFilter Action:=xlFilterCopy, _    
& CopyToRange:=ws6.Range("C2"), Unique:=True

End Sub

0 个答案:

没有答案