user8621952
user8621952

Reputation: 11

Copy specific cells to other cells based on conditions using VBA

I am completely self-taught and that I have no idea what I am doing. I am trying to create a VBA macro to search 2 different cells for a condition, and then if it is true copy data in cells from a worksheet to another worksheet.

I have been piecing together code based on what I have learned online. How can I get this to work?

What I am trying to do:

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”

Here's what I have so far, but no luck.

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

Upvotes: 1

Views: 1040

Answers (1)

user4039065
user4039065

Reputation:

Store the random columns into an organized array and use that array to bring the values into the target workbook's active worksheet.

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

See How to avoid using Select in Excel VBA.

Upvotes: 1

Related Questions