簡體   English   中英

我想根據 vba 中的某些條件將一個工作簿中的一些行粘貼到另一個工作簿

[英]I want to paste some rows from one workbook to another based on some criteria in vba

我在最后 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

嘗試按值粘貼:

代替

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM