Excel VBA - 根据条件将单元格复制到保存在同一文件夹中的另一个工作簿答案

【问题标题】：Excel VBA - Copy cells based on criteria to another workbook saved in the same folderExcel VBA - 根据条件将单元格复制到保存在同一文件夹中的另一个工作簿
【发布时间】：2015-04-21 10:19:27
【问题描述】：

我对此很陌生，我已经阅读了大量教程，但我似乎无法掌握如何在 excel VBA 中实现此结果的概念。我会尽量详细一点。

我有一个包含 3 个 Excel 文件的文件夹 -

Script.xlsx（只是一个保存脚本/宏的按钮）
WhiteCrown.xlsx（我要从中复制数据的工作簿）
PackCon.xlsx（我希望将数据粘贴到的工作簿）

概念：如果 Workbook ("WhiteCrown.xlsx") 包含 B5:B10000 列中的值 = Workbook ("PackCon.xlsx") 列 B5:B10000 AND Workbook ("WhiteCrown.xlsx") 包含列 E 中的值

有 2 个单元格我不想复制 E 的值 - "soy-milk" "Pepsi-max"

检查将循环到 b 列达到10000

:) 提前感谢

Sub ConvertData()

Dim i As Integer, n As Integer
Dim Desc As Range, ExDesc As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngLookup As Range
Dim v

Application.ScreenUpdating = False

Set wb1 = Workbooks.Open("C:\Users\amir.abdul\Desktop\Completed\New folder\WhiteCrown.xlsx")
Set ws1 = wb1.Sheets("BOMQ")

Set wb2 = Workbooks.Open("C:\Users\amir.abdul\Desktop\Completed\New folder\PackCon.xlsx")
With wb2.Sheets("("BOMQ")")
    Set rngLookup = .Range(.Cells(7, 2), _
                    .Cells(7, 2).End(xlDown)).Resize(, 3)
End With

With ws1
    i = 7
    Do Until .Cells(i, 2) = ""
        v = Application.VLookup(.Cells(i, 2).Value, rngLookup, 3, False)
        If Not IsError(v) Then .Cells(i, 4).Value = v
        i = i + 1
    Loop
End With

wb2.Close False


End Sub

*脚本已更新但仍无法正常工作

【问题讨论】：

请展示您已经尝试过的内容。
到目前为止你尝试过什么代码？尝试对您解释的逻辑进行编码，然后将问题发回。
您是否尝试过录制宏并手动执行操作以查看VBA Excel 创建了什么？
我将从计算机登录以添加我的脚本，因为它不允许我通过手机添加它。我基本上经历了一堆完成类似任务的教程，但我无法得到我想要的结果......请给我一点时间，因为我目前正在旅途中。
我已经尝试过宏，但它无法正确验证正在复制的数据

标签： excel vba copy criteria

【解决方案1】：

我不明白您要复制什么数据。我已经展示了这样做的逻辑。经过测试并且可以正常工作。

Option Explicit

Private Sub btnScript_Click()

Dim WhiteCrown As Workbook, PackCon As Workbook, DestWorkbook As Workbook
Dim SheetWhiteCrown As Worksheet, SheetPack As Worksheet
Dim RowIndex As Long
Dim RngWhite As Range
Dim RngWhiteCount As Long
Dim ValBWhite, ValBPack, ValEWhite As String

Application.ScreenUpdating = False

Set WhiteCrown = Workbooks.Open("C:\Users\Mani\Desktop\Stackoverflow\WhiteCrown.xlsx")
Set SheetWhiteCrown = WhiteCrown.Sheets("BOMQ")
Set RngWhite = SheetWhiteCrown.Range("RngWhiteData")

RngWhiteCount = SheetWhiteCrown.Range("RngWhiteData").Rows.Count + 5


Set PackCon = Workbooks.Open("C:\Users\Mani\Desktop\Stackoverflow\PackCon.xlsx")
Set SheetPack = PackCon.Sheets("BOMQ")

Set DestWorkbook = Workbooks.Open("C:\Users\Mani\Desktop\Stackoverflow\Script.xlsx")

For RowIndex = 5 To RngWhiteCount
     ValBWhite = SheetWhiteCrown.Cells(RowIndex, "B").Value
     ValBPack = SheetPack.Cells(RowIndex, "B").Value
     ValEWhite = SheetWhiteCrown.Cells(RowIndex, "E").Value

    If Not ValBWhite = "" And ValBWhite = "" Then

         If Not ((ValEWhite = "SoyMilk") Or (ValEWhite = "Pepsi")) Then

           'Perform your copy to Destworkbook or vlookup or anything               
         Else
             'Do Nothing
         End If

    End If

Next RowIndex
WhiteCrown.Close
PackCon.Close
DestWorkbook.Close False

End Sub

永远不要使用像 Range("B10:E60") 这样的硬编码范围。使用上述代码中的命名范围涉及的最佳编码实践（例如“RngWhiteData”是命名范围）。添加错误验证。

如果您满意，请投票给这个答案。

问候，

玛尼

【讨论】：