Excel 如何使用VBA将基于某些标准的粘贴数据从一个工作簿复制到另一个工作簿（特定单元格）？

我写了下面的代码，用于将数据从一个工作簿复制到另一个工作簿中的特定单元格（我认为这是一个挑战，目标文件下面有月份和相关数据，每个月我都需要将数据复制到当前月份列，这就是为什么使用“最后一列”的原因）函数不覆盖历史月份，也可以动态转到最后一列，其中没有数据（当前月份）。即使代码运行良好，我也希望对其进行优化，以便轻松调试，避免将来出现问题；本年度发生了变化。你有什么想法可以让我的代码更好吗

代码

Dim  x, LastRow, LastColumn, workfile, sourcefile As String
 
 sourcefile = ActiveWorkbook.Name
 workfile = ThisWorkbook.Name


LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(28, 21).End(xlToLeft).Column + 1 
    Workbooks(workfile).Worksheets("A").Cells(28, Lastcolumn2).PasteSpecial xlPasteValues
Else

End If

If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn3 = Workbooks(workfile).Worksheets("A").Cells(29, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(29, Lastcolumn3).PasteSpecial xlPasteValues
Else
End If

If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn4 = Workbooks(workfile).Worksheets("A").Cells(35, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(35, Lastcolumn4).PasteSpecial xlPasteValues
    Else
    End If
    
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn5 = Workbooks(workfile).Worksheets("A").Cells(36, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(36, Lastcolumn5).PasteSpecial xlPasteValues
    Else
    End If
    Next

---

您需要做的只是确定每个条件的目标行，然后将该值插入要执行的代码块中。这样，您就避免了重复多次相同的代码

以下是您将如何做到这一点：

Dim  x, LastRow, LastColumn, workfile, sourcefile, exchangedownload1, exchangedownload2 As String
Dim targetRow As Integer

sourcefile = ActiveWorkbook.Name
workfile = ThisWorkbook.Name

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1

    ' store the values you are wanting to examine in these 2 variables
    exchangedownload1 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value
    exchangedownload2 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value

    ' determine the value for targetRow in this Case statement
    Select Case exchangedownload2
        Case Is "GBP"
            If exchangedownload1 = "001B" Then
                targetRow = 28
            ElseIf enchangedownload1 = "001R" Then
                targetRow = 29
        Case Is "EUR"
            If exchangedownload1 = "001B" Then
                targetRow = 35
            ElseIf enchangedownload1 = "001R" Then
                targetRow = 36
    End Select

    ' this is your code block that was being repeated with just a 
    ' different value for your targetRow, so just plug the value for 
    ' targetRow where it belongs and you only have to have this code block once
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetRow, 21).End(xlToLeft).Column + 1 
    Workbooks(workfile).Worksheets("A").Cells(targetRow, Lastcolumn2).PasteSpecial xlPasteValues

Next

---

您需要做的只是确定每个条件的目标行，然后将该值插入要执行的代码块中。这样，您就避免了重复多次相同的代码

以下是您将如何做到这一点：

Dim  x, LastRow, LastColumn, workfile, sourcefile, exchangedownload1, exchangedownload2 As String
Dim targetRow As Integer

sourcefile = ActiveWorkbook.Name
workfile = ThisWorkbook.Name

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1

    ' store the values you are wanting to examine in these 2 variables
    exchangedownload1 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value
    exchangedownload2 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value

    ' determine the value for targetRow in this Case statement
    Select Case exchangedownload2
        Case Is "GBP"
            If exchangedownload1 = "001B" Then
                targetRow = 28
            ElseIf enchangedownload1 = "001R" Then
                targetRow = 29
        Case Is "EUR"
            If exchangedownload1 = "001B" Then
                targetRow = 35
            ElseIf enchangedownload1 = "001R" Then
                targetRow = 36
    End Select

    ' this is your code block that was being repeated with just a 
    ' different value for your targetRow, so just plug the value for 
    ' targetRow where it belongs and you only have to have this code block once
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetRow, 21).End(xlToLeft).Column + 1 
    Workbooks(workfile).Worksheets("A").Cells(targetRow, Lastcolumn2).PasteSpecial xlPasteValues

Next

这是“工作文件”的截图，我需要每月在相关月份栏下复制数据。变化区域的影响率仅限于公式和计算。所以复制的是之前的内容：从8月份开始的空列，bcoz我已经在7月份运行了它，正如我所说，它可以工作，但代码似乎太复杂，很难为其他人调试

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
    ' store the values you are wanting to examine in these 2 variables
    xrate1 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value
    xrate2 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value

    ' determine the value for targetRow in this Case statement
    Select Case xrate2
        Case "GBP"
    Select Case xrate1
        Case "001B": targetrow = 28
    Case Else: targetrow = 29
    End Select
    Select Case xrate2
        Case "EUR"
    Select Case xrate1
        Case "001B": targetrow = 35
     Case Else: targetrow = 36
    End Select

    ' copying data
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetrow, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(targetrow, Lastcolumn2).PasteSpecial xlPasteValues
Next

这是“工作文件”的截图，我需要每月在相关月份栏下复制数据。变化区域的影响率仅限于公式和计算。所以复制是在这之前的：空列当前从8月份开始，bcoz我已经在7月份运行了它，正如我所说，它可以工作，但是代码似乎太复杂，很难为其他人调试

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
    ' store the values you are wanting to examine in these 2 variables
    xrate1 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value
    xrate2 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value

    ' determine the value for targetRow in this Case statement
    Select Case xrate2
        Case "GBP"
    Select Case xrate1
        Case "001B": targetrow = 28
    Case Else: targetrow = 29
    End Select
    Select Case xrate2
        Case "EUR"
    Select Case xrate1
        Case "001B": targetrow = 35
     Case Else: targetrow = 36
    End Select

    ' copying data
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetrow, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(targetrow, Lastcolumn2).PasteSpecial xlPasteValues
Next

以上是调整后的一个，因为我不能将If语句与Case一起使用，Case是If、Elseif的替换。但仍然收到编译错误，表示它是“下一个不带For”和结束Select而不带Case语句((

---

上面是调整后的一个，因为我不能将If语句与Case一起使用，Case是If，Elseif的替换。但是仍然收到编译错误，说它是“Next without For”和End Select without Case语句(（

此问题可能更适合。此问题可能更适合。'确定本案例陈述中targetRow的值选择案例xrate2案例为=GBP如果xrate1=“001B”，则targetRow=28 ElseIf xrate1=“001R”然后targetrow=29选择案例xrate2案例为=欧元如果xrate1=“001B”则targetrow=35 ElseIf xrate1=“001R”则targetrow=36结束选择"这一部分不起作用，因为它说的是编译错误：结束选择而没有选择大小写。@NigarHuseynzade我不理解你的评论，你想表达什么？你对我的答案有疑问吗？或者你在实现它时有问题吗？很抱歉，也许我不清楚，我在实现上面的代码时遇到了问题，而这些代码是你写的正如显示的错误一样，我对其进行了一些更改，但仍然不起作用。“在本案例语句中确定targetRow的值，选择案例xrate2案例为=GBP如果xrate1=“001B”，则targetRow=28 ElseIf xrate1=“001R”然后targetrow=29选择案例xrate2案例为=欧元如果xrate1=“001B”则targetrow=35 ElseIf xrate1=“001R”则targetrow=36结束选择"这一部分不起作用，因为它说的是编译错误：结束选择而没有选择大小写。@NigarHuseynzade我不理解你的评论，你想表达什么？你对我的答案有疑问吗？或者你在实现它时有问题吗？很抱歉，也许我不清楚，我在实现上面的代码时遇到了问题，而这些代码是你写的由于显示错误，我对其进行了一些更改，但仍然不起作用。