Question

我完全是自学成才，我不知道自己在做什么。我正在尝试创建一个VBA宏来搜索2个不同的单元格中的条件，然后如果它是真的将单元格中的数据从工作表复制到另一个工作表。

我一直根据我在网上学到的东西拼凑代码。我怎样才能让它发挥作用？

我想做什么：

Open “sept daily report”, open page “CM PROC”
IF cell  (“AJ”) = today   AND cell (“AM”) = “con”  THEN
Copy/ past From “cm pro” to “info”
Start on “A3” on “info” sheet
“AH” to “A”
“K” to “B”
“N” to “C”
“O” to “D”
“P” to “E”
“Q” to “F”
“AJ” to “G”
“S” to “H”
“T” to “I”
“U” to “J”
“Y” to “L”
“AB” to “M”
Close “sept daily report”

这是我到目前为止所做的，但没有运气。

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

请参阅How to avoid using Select in Excel VBA。

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

1 个答案: