Question

我需要根据特定条件将行移动到新工作表。我在这里找到了一个非常有用的讨论，它几乎就是我需要的，但需要从主表中删除行。我一直在使用的代码是：

Option Explicit

Sub Fr33M4cro()

Dim sh33tName As String
Dim custNameColumn As String
Dim i As Long
Dim stRow As Long
Dim customer As String
Dim ws As Worksheet
Dim sheetExist As Boolean
Dim sh As Worksheet

sh33tName = "Sheet1"
custNameColumn = "I"
stRow = 2

Set sh = Sheets(sh33tName)

For i = stRow To sh.Range(custNameColumn & Rows.Count).End(xlUp).Row
    customer = sh.Range(custNameColumn & i).Value
    For Each ws In ThisWorkbook.Sheets
        If StrComp(ws.Name, customer, vbTextCompare) = 0 Then
            sheetExist = True
            Exit For
        End If
    Next
    If sheetExist Then
        CopyRow i, sh, ws, custNameColumn
    Else
        InsertSheet customer
        Set ws = Sheets(Worksheets.Count)
        CopyRow i, sh, ws, custNameColumn
    End If
    Reset sheetExist
Next i

End Sub

Private Sub CopyRow(i As Long, ByRef sh As Worksheet, ByRef ws As Worksheet, custNameColumn As String)
Dim wsRow As Long
wsRow = ws.Range(custNameColumn & Rows.Count).End(xlUp).Row + 1
sh.Rows(i & ":" & i).Copy
ws.Rows(wsRow & ":" & wsRow).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Private Sub Reset(ByRef x As Boolean)
x = False
End Sub

Private Sub InsertSheet(shName As String)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = shName
End Sub

任何见解都会有所帮助，因为我对此很陌生。谢谢！

Answer 1

试试这个：

Private Sub CopyRow(i As Long, ByRef sh As Worksheet, ByRef ws As Worksheet, custNameColumn As String)
Dim wsRow As Long
wsRow = ws.Range(custNameColumn & ws.Rows.Count).End(xlUp).Row + 1

ws.Rows(wsRow).EntireRow.Value = sh.Rows(i).EntireRow.Value
sh.Rows(i).EntireRow.Delete
End Sub

注意：ws.前面的Rows.Count。此外，由于您只需要值，因此可以将范围设置为彼此相等。通过这种方式，您可以绕过剪贴板使用它的速度更快。

注意：由于您将要删除行，因此在调用此子句的循环中，我建议从 end 开始，然后朝着顶部开始：

For i = sh.Range(custNameColumn & sh.Rows.Count).End(xlUp).Row to stRow Step -1

那应该有用。否则，将i = i - 1添加到CopyRow子的末尾，并使i全局。

如果您只想要列A-M（1到13），您可以这样做：

ws.Range(ws.cells(i,1),ws.cells(i,13)).Value = sh.Range(sh.Cells(i,1),sh.Cells(i,13)).Value

（我可能会倒退，或i切换，但你应该明白这一点。）

使用特定条件将行剪切/粘贴到新工作表

1 个答案: