Excel VBA复制范围内已过滤的数据和追加到另一个工作表上的表末尾
我有一个问题,但我的VBA是新手,无法弄清楚我的代码出了什么问题。Excel VBA复制范围内已过滤的数据和追加到另一个工作表上的表末尾
我想要实现的是:
步骤1。在工作表1中,单元格B8中的标题下方有大量数据:BR8
第2步。我过滤单元格BE8非空白
步骤3。我复制BE8:BN8下的过滤数据(不包括标题,因此我不需要全部数据,因此我只是复制完整数据的一个子集)
步骤4。我去了Sheet 2,在那里我有一个C8:L8标题的填充表格,与表格1中的标题BE8:BN8完全一致。
Step 5。我想将此新复制的一组数据追加到工作表2中的此表末尾
第6步。我要回去表1和标题下删除一些过滤的数据,特别是那些BE8,BK8:BN8
这里是我的尝试,我一直在努力,从另一个代码适应:
Sub TransferData()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim RngBeforeFilter As Range, RngAfterFilter As Range
Dim LCol As Long, LRow As Long
With ThisWorkbook
Set WS1 = .Sheets("Sheet1")
Set WS2 = .Sheets("Sheet2")
End With
With WS1
'Make sure no other filters are active.
.AutoFilterMode = False
'Get the correct boundaries.
LRow = .Range("BE" & .Rows.Count).End(xlUp).Row
LCol = .Range("BE8:BN8").Column
'Set the range to filter.
Set RngBeforeFilter = .Range(.Cells(1, 2), .Cells(LRow, LCol)).Offset(1)
RngBeforeFilter.Rows(8).AutoFilter Field:=56, Criteria1:="<>"
'Set the new range, but use visible cells only.
Set RngAfterFilter = .Range(.Cells(1, 7), .Cells(LRow, LCol)).SpecialCells(xlCellTypeVisible)
'Copy the visible cells from the new range.
RngAfterFilter.Copy WS2.Range("C65536").End(xlUp)
'Clear filtered data (not working)
Sheets("Sheet1").Range("B8", Range("B8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
.ShowAllData
End With
End Sub
我将不胜感激您提供的任何帮助。
感谢 雅克
的几个问题在这里:
.Range("BE8:BN8").Column
可能不是做你所期望的 - 它只是返回时的列数(即57)。
RngBeforeFilter是什么都不做 - 你可以只使用
.Rows(8).AutoFilter Field:=56, Criteria1:="<>"
你说你想中的数据复制:BN,但你从A列开始RngAfterFilter(即.Cells(1,7))。
WS2.Range("C65536").End(xlUp)
给出使用的最后一行,而您需要粘贴到下一行。
您正在清除B列,而不是列BE,BK和BN。
因此,试试这个来代替:
Sub TransferData()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim RngBeforeFilter As Range, RngAfterFilter As Range
Dim BECol As Long, BNCol As Long, LRow As Long
With ThisWorkbook
Set WS1 = .Sheets("Sheet1")
Set WS2 = .Sheets("Sheet2")
End With
With WS1
'Make sure no other filters are active.
.AutoFilterMode = False
'Get the correct boundaries.
LRow = .Range("BE" & .Rows.Count).End(xlUp).Row
BECol = .Range("BE8").Column
BNCol = .Range("BN8").Column
'Set the range to filter.
.Rows(8).AutoFilter Field:=BECol - 1, Criteria1:="<>"
'Set the new range, but use visible cells only.
Set RngAfterFilter = .Range(.Cells(9, BECol), .Cells(LRow, BNCol)).SpecialCells(xlCellTypeVisible)
'Copy the visible cells from the new range.
RngAfterFilter.Copy WS2.Range("C65536").End(xlUp).Offset(1)
'Clear filtered data
.Range("BE9", Range("BE8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
.Range("BK9", Range("BK8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
.Range("BN9", Range("BN8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
.ShowAllData
End With
End Sub
嗨,Hambone,Eileen R和bobajob,请在下面的答案中看到模型。谢谢Jacque –
出了什么问题与您的代码准确,你有什么话想调试吗? –
它只是没有找到写入列,然后它也追加了标题。另外,清除的内容是删除所有记录。 –
这只是没有足够的信息或足够具体的问题,对不起。 –