Question

我在最后3行代码中遇到问题，我只想将选定的值复制到另一个工作簿中，请帮助我。

Sub y()
    Set ws1 = Workbooks("A.xlsx").Worksheets(1)    
    Set ws2 = Workbooks("B.xlsx").Worksheets(1)    
    Set ws3 = ThisWorkbook    

    Lastrowo = ws1.Cells(Rows.Count, "B").End(xlUp).Row
    Lastrowc = ws2.Cells(Rows.Count, "B").End(xlUp).Row

    For i = 2 To Lastrowo
        If ws1.Cells(i, "AF").Value = "X" Then
            ws1.Rows(i).EntireRow.Delete
        End If
    Next i

    For j = 2 To Lastrowc
        If ws2.Cells(j, "AF").Value = "X" Then
            ws2.Rows(j).EntireRow.Delete
        End If
    Next j

    ws2.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove   
    ws2.Range("B2").FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(RC[-1],'[A.xlsx]Sheet1'!C1,1,FALSE)),""Add"","""")"    
    ws2.Range("B2").AutoFill Destination:=ws2.Range("B2:B" & Lastrowc), Type:=xlFillDefault

    With ws2.UsedRange    
        .Copy        
        .PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With

    For k = 2 To Lastrowc   
        If ws2.Cells(k, "B").Value = "Add" Then
            'in these 3 lines is the issue   
            ws2.Rows(k).EntireRow.Copy   
            Windows("Addition.xlsm").Activate    
            Workbooks("Addition.xlsm").Worksheets(1).Rows(2).paste   
        End If
    Next k
End Sub

Answer 1

尝试按值粘贴：

替换

ws2.Rows(k).EntireRow.Copy   
Windows("Addition.xlsm").Activate    
Workbooks("Addition.xlsm").Worksheets(1).Rows(2).paste

与

ws2.Rows(k).EntireRow.Copy   
Workbooks("Addition.xlsm").Worksheets(1).Rows(2).PasteSpecial xlPasteValues

我想根据vba中的某些条件将一些工作簿中的某些行粘贴到另一个工作簿

1 个答案: