VBA EXCEL复制范围

时间:2015-02-25 22:09:11

标签: excel vba excel-vba range

我刚才发布了同样的问题,被告知我拼错了。我把问题放下了;因为我以为我知道我试图称之为一种方法......这就是我的范围(是的,这张照片拼写为sheeet)。我想我还是不明白。我正在尝试将“A2”列通过“D”列的最后一个单元格从“TEXT”复制到Sheet3

Dim TotalRows As Integer
Dim CurrentWorkbook As Workbook ' macro workbook
Dim RangeToCopy As Range
Dim ColumnLetterNumber As String

Set CurrentWorkbook = ThisWorkbook
TotalRows = Sheets("TEXT").UsedRange.Rows.Count
ColumnLetterNumber = "D" & TotalRows


Set RangeToCopy = Range("A2", ColumnLetterNumber)

' Group Last Observed within the first three columns
' Last Observed start in column N
' After Insert end up in column )

 Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

' Move the Last observed (now column O) to Column D so that they can be fitered together

Sheets("TEXT").Range(Range("O1"), Range("O1").End(xlDown)).Copy Sheets("TEXT").Range("D1")

With Sheets("TEXT")
 .AutoFilterMode = False
 .Range("A1:D1").AutoFilter
End With
'
'Copy Columns to the POAM sheet
Set RangeToCopy = Range("A2", ColumnLetterNumber) 'top left, bottom right
RangeToCopy.Select
CurrentWorkbook.Sheets("Sheet3").Activate


CurrentWorkbook.Sheets("TEXT").Range(RangeToCopy).Copy Action:=xlFilterCopy, _
CopyToRange:=Sheets("Sheet3").Range("A1"), unique:=True


End Sub

2 个答案:

答案 0 :(得分:1)

我之前回答了你更详细的问题。这不起作用,因为这条线至少有两个原因不起作用:

CurrentWorkbook.Sheets("TEXT").Range(RangeToCopy).Copy Action:=xlFilterCopy, _
    CopyToRange:=Sheets("Sheet3").Range("A1"), unique:=True

首先,“RangeToCopy”不是工作表上的已定义范围,因此您无法以这种方式引用它。它是VBA代码中的变量,因此您只需要在此范围内使用复制功能。其次,Range Class的Copy函数没有所有这些参数。你想要:

RangeToCopy.Copy Destination:=Sheets("Sheet3").Range("A1")

如果您实际上尝试获取唯一值,则需要使用“AdvancedFilter”功能。

RangeToCopy.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Sheet3").Range("A1"), unique:=True,  criteriarange:= <Insert range that you wish to get unique values from here> 

此外,您应该根据工作表名称定义RangeToCopy:

Set RangeToCopy = Sheets("TEXT").Range("A2", ColumnLetterNumber)

答案 1 :(得分:0)

你不是在做这个吗?

Sub Macro()

    Dim dEnd As Integer

    Sheets("Sheet1").Select

    Range("D1").Select
    dEnd = Selection.End(xlDown).Row

    Range("A2:" & "D" & dEnd).Copy

    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste

    Application.CutCopyMode = False

End Sub

(我没有打扰工作表名称)