使用动态范围的Excel VBA复制和粘贴脚本

时间:2016-07-15 16:35:07

标签: excel vba excel-vba

我有一个数据表,根据我创建的高级过滤器填充文件中的其他工作表。我只需要从高级过滤器中复制某些列,而不是根据所需的报告复制整个过滤器。当高级过滤器没有返回任何内容(意味着当月没有匹配项)时,脚本正在复制并粘贴标题,而不是复制和粘贴任何内容。当高级过滤器没有结果时,有关如何避免复制和粘贴标题的任何建议?以下是要复制的第一个工作表的脚本:

Sub Populate()

Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set sht = Worksheets("Data")


sht.Range("A1:S400").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Sheets("Sheet1").Range("A1:S12"), Unique:=False


Set StartCell = sht.Range("G2")
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column

   sht.Range(StartCell, sht.Cells(LastRow, "M")).Copy
   Worksheets("OC 2016 - Post-65").Range("A18").PasteSpecial Paste:=xlPasteValues


Sheet3.Columns().AutoFit
Application.CutCopyMode = False

1 个答案:

答案 0 :(得分:0)

对于那些可能遇到类似问题并希望了解我如何解决问题的人,我会发布我编辑的内容,感谢上面的Scott的答案。我不是专家,所以我可能错放了If语句,但它正在我正在做的事情上工作。

Sub Populate()

Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set sht = Worksheets("Data")


sht.Range("A1:S400").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Sheets("Sheet1").Range("A1:S12"), Unique:=False


Set StartCell = sht.Range("G2")
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column

If LastRow > 2 Then

sht.Range(StartCell, sht.Cells(LastRow, "M")).Copy
Worksheets("OC 2016 - Post-65").Range("A18").PasteSpecial Paste:=xlPasteValues

End If

Sheet3.Columns().AutoFit
Application.CutCopyMode = False