时间戳

首页 > 解决方案 > 在两张纸之间剪切复制粘贴循环指令

excel - 在两张纸之间剪切复制粘贴循环指令

问题描述

我在下面的问题中得到了一些答案，但是尽管进行了多次尝试，但我认为我的代码现在完全是一团糟，无法弄清楚哪里错了。

所以我有一个范围 A12:N112 需要在 A 行上按降序排序。

接下来，我需要复制 A 列中包含“1”的每一行 (B:L)，并将其粘贴到另一个工作簿的第一个空白行中，基于 D 列为空白。然后，我需要为我刚刚粘贴到的行复制 A 列中生成的数字，然后将其粘贴回我在第一个电子表格的 N 行中复制的原始行。

然后我需要这个循环，直到我们在第一个电子表格中达到“0”的第一个值。

这是我的代码，虽然我可以让排序工作，但我根本无法复制或粘贴任何内容。这类似于我之前用于单个剪切复制粘贴的代码，但在这里根本无法让它工作。

Dim r As Long
Dim lr As Long
Dim wkb As Workbook
Dim ws As Worksheet
Dim wkb2 As Workbook
Dim ws2 As Worksheet

Set wkb = ThisWorkbook
Set ws = wkb.Worksheets("Data Entry")
Set wkb2 = Workbooks.Open("\\srveurfcl03.nov.com\IS-GBR-GLBISETNRegister$\Serial No Trial\Serialisation Log.xlsx")
Set ws2 = wkb2.Worksheets("SNo Log")

wkb.Activate
ws.Activate
ActiveWorkbook.Worksheets("Data Entry").sort.SortFields.Clear
ActiveWorkbook.Worksheets("Data Entry").sort.SortFields.Add Key:=Range( _
    "A12:A112"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("Data Entry").sort
   .SetRange Range("A11:N112")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

For r = 12 To lr
If wkb.ws.Cells(r, 1).Value = 1 Then
    ws.Cells(r, "B:L").Copy

    wkb2.Activate
    ws2.Activate
    Range("D" & Rows.Count).EndX(x1Up).Offset(1).Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste
    Range("A" & Rows.Count).End(xlUp).Offset(0).Select
    Selection.Copy
    wkb.Activate
    ws.Cells(r, 13).Value.Paste
End If
If wkb.ws.Cells(r, 1).Value = 0 Then
   ws.Cells(4, 9).Select
   ActiveCell.FormulaR1C1 = "Serial No. Issue complete for this OA"
End If
Range("F5").Select
Next r

任何帮助将不胜感激，因为它总是如此。我尝试设置变量，但由于对象错误，无法让它们在我的代码位上工作，因此不得不返回我知道有效的代码。但这仅适用于固定范围，我不会在本工作簿中提及。

标签： excelvba

解决方案

根据我的评论，您不需要对数据进行排序或使用Activate. 使用Range("D" & Rows.Count).EndX(x1Up).Offset(1)方向是正确的，除非您需要删除EndX. 此外，下面的代码部分没有任何意义。所以你需要澄清你想要什么，如果需要的话，包括一个结果的例子。

    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste
    Range("A" & Rows.Count).End(xlUp).Offset(0).Select
    Selection.Copy
    wkb.Activate
    ws.Cells(r, 13).Value.Paste
End If
If wkb.ws.Cells(r, 1).Value = 0 Then
   ws.Cells(4, 9).Select
   ActiveCell.FormulaR1C1 = "Serial No. Issue complete for this OA"
End If
Range("F5").Select

复制范围的最佳方法是复制整个范围，而不是逐行复制。下面的代码将隐藏Range("A12:A112")A 列中没有“1”的所有行。然后它将使用复制范围内的可见单元格SpecialCells(xlCellTypeVisible)并粘贴到ws2.Column(4). 然后它使所有隐藏的行再次可见。如果您的工作簿和工作表变量正确，则此代码将起作用。

Dim ws As Worksheet
Dim wkb2 As Workbook
Dim ws2 As Worksheet
Dim Rng As Range

Set ws = ThisWorkbook.Worksheets("Data Entry")
Set wkb2 = Workbooks.Open("\\srveurfcl03.nov.com\IS-GBR-GLBISETNRegister$\Serial No Trial\Serialisation Log.xlsx")
Set ws2 = wkb2.Worksheets("SNo Log")

    For Each cell In ws.Range("A12:A112")
        If cell.Value <> "1" Then
            cell.EntireRow.Hidden = True
        End If
    Next cell

    Set Rng = ws.Range("A12:A112").SpecialCells(xlCellTypeVisible)
        Rng.Copy Destination:=ws2.Cells(Rows.Count, 4).End(xlUp).Offset(1)

    ws.Range("A12:A112").EntireRow.Hidden = False

推荐阅读