Copy Data From One Sheet To Another With VBA

[wavery]

Gaming Month

Gaming Month Name

Gaming Year

Denom

Game Type

Jackpot

Coin In

CIPUPD

Coin Out

Actual Win

Theo Win

Handle Pulls

Days on Floor

Fee Amt

Asset Number

Area

Section

Location

MFG

THEME

EPROM

WPUPD

LEASE or NOT

1

1/1/2018

2018

1

VR

8.00

1234

Lease

2

2/1/2018

2018

5

VP

8.00

4321

Not Lease

<tbody>
</tbody>

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