Reputation: 11
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
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