![](/img/trans.png)
[英]How to copy paste data based on some criterias from one workbook to another(specific cells) using 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.