使用VBA根据条件将特定单元格复制到其他单元格

我完全自学成才，不知道自己在做什么。 我正在尝试创build一个VBAmacros来search2个不同的单元格作为条件，然后如果它是真实的从工作表单元复制数据到另一个工作表。

我一直在拼凑基于我在网上学到的东西。 我怎样才能使这个工作？

我在做什么：

打开“sept每日报告”，打开“CM PROC”
 IF cell（“AJ”）= today AND cell（“AM”）=“con”THEN
复制/过去从“cm pro”到“info”
从“信息”表上的“A3”开始
 “AH”到“A”
 “K”到“B”
 “N”到“C”
 “O”到“D”
 “P”到“E”
 “Q”到“F”
 “AJ”到“G”
 “S”到“H”
 “T”到“我”
 “U”到“J”
 “Y”到“L”
 “AB”到“M”
closures“sept每日报告”

这是我迄今为止，但没有运气。

Sub Macro4() ' ' Macro4 Macro ' Dim LastRow As interger, i As Integer, errow As interger Workbooks.Open Filename:= _ "S:\OPS\FY17 FILES\Daily Report\September Daily Report.xlsx", UpdateLinks:=0 Sheets("CM Proc").Select LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row For i = 2 To LastRow If Cells("AJ") = mydate And Cells("AM") = "con" Then erow = ActiveSheet.Cells(Row.Count, 2).End(xlUp).Offset(1, 0).Row Sheets("CM Proc").Select Windows("September Daily Report.xlsx").Activate Range("O").Select Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("D").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate Range("P").Select Application.CutCopyMode = False Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("E").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate Range("Q").Select Application.CutCopyMode = False Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("F").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate Range("S").Select Application.CutCopyMode = False Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("H").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate Range("N").Select Application.CutCopyMode = False Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("C").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate Range("K").Select Application.CutCopyMode = False Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("B").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate Range("AH").Select Application.CutCopyMode = False Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("A").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate ActiveWindow.SmallScroll ToRight:=3 Range("AJ").Select Application.CutCopyMode = False Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("G").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate Range("T").Select Application.CutCopyMode = False Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("I").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate Range("U").Select Application.CutCopyMode = False Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("J").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate Range("Y").Select Application.CutCopyMode = False Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("L").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate Range("AB").Select Application.CutCopyMode = False Selection.Copy Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate Range("M").Select ActiveSheet.Paste Windows("September Daily Report.xlsx").Activate ActiveWindow.Close End Sub 

Answer 1

将随机列存储到有组织的数组中，并使用该数组将这些值带入目标工作簿的活动工作表中。

 Option Explicit Sub Macro5() Dim i As Long, xfer As Variant Dim wbDR As Workbook, wbCTC As Workbook, wst As Worksheet Set wbCTC = Workbooks("CONTRACT TAG CREATOR MACRO PROJECT.xlsm") 'the above might be easier as , 'Set wbCTC = ThisWorkbook 'if that is the workbook containing this code Set wst = wbCTC.Worksheets("info") Set wbDR = Workbooks.Open(Filename:="S:\OPS\FY17 FILES\Daily Report\September Daily Report.xlsx", _ UpdateLinks:=0) With wbDR.Worksheets("CM Proc") For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row If Int(.Cells(i, "AJ").Value2) = Date And LCase(.Cells(i, "AM").Value2) = "con" Then ReDim xfer(1 To 1, 1 To 12) xfer(1, 1) = .Cells(i, "AH").Value xfer(1, 2) = .Cells(i, "K").Value xfer(1, 3) = .Cells(i, "N").Value xfer(1, 4) = .Cells(i, "O").Value xfer(1, 5) = .Cells(i, "P").Value xfer(1, 6) = .Cells(i, "Q").Value xfer(1, 7) = .Cells(i, "AJ").Value xfer(1, 8) = .Cells(i, "S").Value xfer(1, 9) = .Cells(i, "T").Value xfer(1, 10) = .Cells(i, "U").Value xfer(1, 11) = .Cells(i, "Y").Value xfer(1, 12) = .Cells(i, "AB").Value With wst .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(UBound(xfer, 1), UBound(xfer, 2)) = xfer End With End If Next i 'optionally close September Daily Report.xlsx 'wbDR.close savechanges:=false End With End Sub 

请参阅如何避免在Excel VBA中使用select 。