VBA按帐号sorting，然后select活动单元格，剪切并粘贴到下一页

所以我logging了一个macros，使标题行filter，然后sorting列B“帐户”select一个特定的帐户号码，然后剪切所有这些单元格（当然减去标题行），并粘贴到表2。

Sub Macro1() ' ' Macro1 Macro ' ' ActiveSheet.Range("$A$1:$O$1923").AutoFilter Field:=2, Criteria1:= _ "905263043" Rows("180:180").Select ActiveWindow.ScrollRow = 3 ActiveWindow.ScrollRow = 184 ActiveWindow.ScrollRow = 202 ActiveWindow.ScrollRow = 217 ActiveWindow.ScrollRow = 234 ActiveWindow.ScrollRow = 249 ActiveWindow.ScrollRow = 266 ActiveWindow.ScrollRow = 284 ActiveWindow.ScrollRow = 301 ActiveWindow.ScrollRow = 316 ActiveWindow.ScrollRow = 333 ActiveWindow.ScrollRow = 345 ActiveWindow.ScrollRow = 363 ActiveWindow.ScrollRow = 380 ActiveWindow.ScrollRow = 400 ActiveWindow.ScrollRow = 425 ActiveWindow.ScrollRow = 447 ActiveWindow.ScrollRow = 477 ActiveWindow.ScrollRow = 531 ActiveWindow.ScrollRow = 559 ActiveWindow.ScrollRow = 606 ActiveWindow.ScrollRow = 663 ActiveWindow.ScrollRow = 725 ActiveWindow.ScrollRow = 757 ActiveWindow.ScrollRow = 821 ActiveWindow.ScrollRow = 854 ActiveWindow.ScrollRow = 925 ActiveWindow.ScrollRow = 992 ActiveWindow.ScrollRow = 1084 ActiveWindow.ScrollRow = 1166 ActiveWindow.ScrollRow = 1218 ActiveWindow.ScrollRow = 1262 ActiveWindow.ScrollRow = 1300 ActiveWindow.ScrollRow = 1342 ActiveWindow.ScrollRow = 1357 ActiveWindow.ScrollRow = 1362 ActiveWindow.ScrollRow = 1367 ActiveWindow.ScrollRow = 1369 Rows("180:1407").Select Selection.Cut Sheets("Sheet2").Select Range("A2").Select ActiveSheet.Paste End Sub 

问题是我每周都会做这个报告，而且由于付款或账单的不同，这些账户也会有所不同。 所以下一次不会是从180行到1407行。

那么如何编写一个通用的VBA来selectfiltersorting的所有活动单元格，减去标题，剪切并粘贴到表单2中？

我正在努力解决类似的问题

 Dim rng As Range Set rng = ActiveSheet.UsedRange ActiveSheet.Range("A:O").AutoFilter Field:=2, Criteria1:= _ "905263043" Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1) rng.Select Selection.Cut 

但没有工作

Answer 1

这应该工作。 假设列1中的标题。

 Dim ws as Worksheet Set ws = Worksheets("Sheet1") 'change as needed With ws .UsedRange.AutoFilter Field:=2, Criteria1:="905263043" Dim rng as Range Set rng = Intersect(.UsedRange,.UsedRange.Offset(1)).SpecialCells(xlCellTypeVisible) rng.Copy Worksheets("Sheet2").Range("A2") rng.EntireRow.Delete .UsedRange.AutoFilter End With