Question

我在下面对我的问题有一些答案，但是尽管进行了无数次尝试，我仍然认为我的代码简直是一团糟，无法理解错误所在。

所以我有一个范围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

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

Answer 1

根据我的评论，您无需对数据进行排序或使用Activate。使用Range("D" & Rows.Count).EndX(x1Up).Offset(1)的方向正确，只是您需要删除EndX中的X。另外，下面的代码部分没有任何意义。因此，您需要澄清您想要的内容，并在需要时提供结果示例。

    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)复制该范围内的可见单元格并将其粘贴到{ {1}}。然后，它使所有隐藏的行再次可见。如果您的工作簿和工作表变量正确，则此代码将起作用。

ws2.Column(4)

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

1 个答案: