Copy Data From One Sheet To Another With VBA

[wavery]

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Gaming Month
[/TD]
[TD]Gaming Month Name
[/TD]
[TD]Gaming Year
[/TD]
[TD]Denom
[/TD]
[TD]Game Type
[/TD]
[TD]Jackpot
[/TD]
[TD]Coin In
[/TD]
[TD]CIPUPD
[/TD]
[TD]Coin Out
[/TD]
[TD]Actual Win
[/TD]
[TD]Theo Win
[/TD]
[TD]Handle Pulls
[/TD]
[TD]Days on Floor
[/TD]
[TD]Fee Amt
[/TD]
[TD]Asset Number
[/TD]
[TD]Area
[/TD]
[TD]Section
[/TD]
[TD]Location
[/TD]
[TD]MFG
[/TD]
[TD]THEME
[/TD]
[TD]EPROM
[/TD]
[TD]WPUPD
[/TD]
[TD]LEASE or NOT
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]1/1/2018
[/TD]
[TD]2018
[/TD]
[TD]1
[/TD]
[TD]VR
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]8.00
[/TD]
[TD]1234
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Lease
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]2/1/2018
[/TD]
[TD]2018
[/TD]
[TD]5
[/TD]
[TD]VP
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]8.00
[/TD]
[TD]4321
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Not Lease
[/TD]
[/TR]
</tbody>[/TABLE]
Hello,
I am new to this message board, so I hope I am posting this in the correct area. Here is what I need to accomplish. I have a workbook that I track our machines asset numbers. We have 800 machines some are leased most are not leased. I keep a running table "DATADump", data is dumped into this table monthly. I want to copy the current "Asset Numbers", "Machine Type" & "Lease Cost" for Lease Machines only, from "DATADump" to another worksheet named "Leased Machines". I hope I explained this ok.

Thank you,
Wade

 

[wavery]

Hello,
Sorry I was off yesterday. Yes the year column does have more than one year. I can add a "Year" cell on "REPORTDATE" Cell D2 if needed to filter.

 

[mumps]

This macro uses the date in cell C2 of the "REPORTDAT" sheet.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("DATADump").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ldateto As Long
    Dim ldatefrom As Long
    Dim ThisMonth As Long
    Dim ThisYear As Long
    ThisMonth = Month(Sheets("REPORTDAT").Range("C2"))
    ThisYear = Year(Sheets("REPORTDAT").Range("C2"))
    ldatefrom = DateSerial(ThisYear, ThisMonth, 1)
    ldateto = DateSerial(ThisYear, ThisMonth + 1, 0)
    With Sheets("Leased Machines")
        .UsedRange.ClearContents
        .Range("A1:C1") = Array("Asset Number", "Game Type", "Lease Cost")
    End With
    With Sheets("DATADump").Range("A1").CurrentRegion
        .AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .AutoFilter Field:=23, Criteria1:="Lease"
    End With
    Intersect(Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible), Range("O:O")).Copy Sheets("Leased Machines").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Intersect(Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible), Range("E:E")).Copy Sheets("Leased Machines").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
    Intersect(Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible), Range("N:N")).Copy Sheets("Leased Machines").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
    Sheets("Leased Machines").Columns.AutoFit
    If Sheets("DATADump").AutoFilterMode Then Sheets("DATADump").AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

 

[wavery]

This is great!!!! The Macro created the column headers "Asset Number", Game Type", "Lease Cost", however there was no data?

 

[mumps]

Click here to download a dummy file.
The macro is in Module1.

 

[wavery]

Not sure what I am doing wrong but Im unable to get the test download to work. Same result creates column headers but no data??

 

[mumps]

I just downloaded the file from Post #14 , ran the macro in Module1 and it worked perfectly. What version of Excel are you using?

 

[wavery]

2016

 

[mumps]

Do you have a Mac or PC?

 

[wavery]

PC / WINDOWS 7 PRO / 64-bit OS

Sorry for being difficult, but once working this will save me a lot of time.

Thank you for sticking with this

 

[mumps]

Make sure that "DATADump" sheet is the active sheet when you run the macro or try this version:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("DATADump").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ldateto As Long
    Dim ldatefrom As Long
    Dim ThisMonth As Long
    Dim ThisYear As Long
    ThisMonth = Month(Sheets("REPORTDAT").Range("C2"))
    ThisYear = Year(Sheets("REPORTDAT").Range("C2"))
    ldatefrom = DateSerial(ThisYear, ThisMonth, 1)
    ldateto = DateSerial(ThisYear, ThisMonth + 1, 0)
    With Sheets("Leased Machines")
        .UsedRange.ClearContents
        .Range("A1:C1") = Array("Asset Number", "Game Type", "Lease Cost")
    End With
    With Sheets("DATADump").Range("A1").CurrentRegion
        .AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .AutoFilter Field:=23, Criteria1:="Lease"
    End With
    Sheets("DATADump").Activate
    Intersect(Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible), Range("O:O")).Copy Sheets("Leased Machines").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Intersect(Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible), Range("E:E")).Copy Sheets("Leased Machines").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
    Intersect(Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible), Range("N:N")).Copy Sheets("Leased Machines").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
    Sheets("Leased Machines").Columns.AutoFit
    If Sheets("DATADump").AutoFilterMode Then Sheets("DATADump").AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub