Macro copy with criteria

P

puiuluipui

Hi, can this macro can be modified to copy from range A6:G100 rows that has
in G column today's date?(18.09.2009)

Sub COPY()
MyWorkbook = "" & Format(Date, "dd.mm.yyyy")
Workbooks.Open Filename:="C:\Users\puiut\Desktop\try copy add\Copy Luke\" &
MyWorkbook & ".xls"
Range("A5:T200").Select
Selection.COPY
Windows("Database.xls").Activate
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("B2").Select
End Sub

Can this be done?
Thanks!
 
J

Joel

this code will work except I'm not sure how the dates are store in column g.
I used autofilter and the format of the filtered data in the autofilter may
need to be changed for the code to work. In the us I founc the date and
month are not two digits so you may have to modify the filter to look like
this

from
MyWorkbook = "" & Format(Date, "dd.mm.yyyy")
to
MyWorkbook = "" & Format(Date, "d.m.yyyy")


You will need a different formated date for opening the workbook and the
date used in the autofilter.

I also modifiy the code to specify the worksheets rather than to relie on
the active sheet.


Sub COPY()

MyWorkbook = "" & Format(Date, "dd.mm.yyyy")
Set bk = Workbooks.Open( _
Filename:="C:\Users\puiut\Desktop\try copy add\Copy Luke\" & _
MyWorkbook & ".xls")
Set bk = ThisWorkbook
With bk.Sheets(1)
LastRow = .Range("G" & Rows.Count).End(xlUp).Row
.Columns("G").AutoFilter
.Columns("G").AutoFilter Field:=1, _
Criteria1:=MyWorkbook
.Rows("2:" & LastRow).SpecialCells( _
Type:=xlCellTypeVisible).COPY
End With


With Workbooks("Database.xls").ActiveSheet
.Rows(2).PasteSpecial _
Paste:=xlPasteValues
.Range("B2").Select

End With
End Sub
 
P

puiuluipui

Hi Joel. I've made a misstake. This is the code i need to be changed:

Sub copyanul()
Workbooks.Open Filename:="C:\Users\puiut\Desktop\login
password\apollo\Comenzi ANULATE 2009.xls"
Range("B3").Select
Range("A8:G250").Select
Selection.COPY
Windows("Database.xls").Activate
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("B:H").EntireColumn.AutoFit
Range("E:E,H:H").Select
Range("H1").Activate
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"
Range("B3").Select
Application.CutCopyMode = False
Windows("Comenzi ANULATE 2009.xls").Close
End Sub


I tried to adjust your code to this code, but i can't do it. Can you make
this code copy only rows, from A8:G250 range, with today date in G column?
The same thing like before, but with this code.
Sorry again.
Thanks!
 
J

Joel

Try these changes

Sub COPY()

DateStr = Format(Date, "m/d/yyyy")

Set bk = Workbooks.Open( _
Filename:="C:\Users\puiut\Desktop\login password\" & _
apollo\Comenzi ANULATE 2009.xls"

With bk.Sheets(1)
.Range("G").NumberFormat = fiormat(Date,"m/d/yyyy"
LastRow = .Range("G" & Rows.Count).End(xlUp).Row
.Columns("G").AutoFilter
.Columns("G").AutoFilter Field:=1, _
Criteria1:=DateStr
.Rows("2:" & LastRow).SpecialCells( _
Type:=xlCellTypeVisible).Copy
End With


With Workbooks("Database.xls").ActiveSheet
.Rows(2).PasteSpecial _
Paste:=xlPasteValues
.Range("B2").Select

.Columns("B:H").AutoFit
.Range("E:E,H:H").NumberFormat = "m/d/yyyy"
.Range("B3").Select

End With

bk.Close savechanges:=false

End Sub
 
P

puiuluipui

Hi Joel, i have some errors.
First i had errors with:
Set bk = Workbooks.Open( _
Filename:="C:\Users\puiut\Desktop\login password\" & _
apollo\Comenzi ANULATE 2009.xls"
And i made it like this:
Set bk = Workbooks.Open(Filename:="C:\Users\puiut\Desktop\login
password\apollo\Comenzi ANULATE 2009.xls")
And now i have problem with this:
.Range("G").NumberFormat = Format(Date, "dd.mm.yyyy"
This line is highlited with yellow.
What am i doing wrong?
Thanks!
 
P

puiuluipui

Hi Joel, this is what i have so far:
Sub COPY()
DateStr = Format(Date, "dd/mm/yyyy")
Set bk = Workbooks.Open(Filename:="C:\Users\puiut\Desktop\login
password\apollo\Comenzi ANULATE 2009.xls")
With bk.Sheets(1)
Columns("G").NumberFormat = Format(Date, "dd/mm/yyyy")
LastRow = .Range("G" & Rows.Count).End(xlUp).Row
.Columns("G").AutoFilter
.Columns("G").AutoFilter Field:=1, _
Criteria1:=DateStr
.Rows("2:" & LastRow).SpecialCells( _
Type:=xlCellTypeVisible).COPY
End With
With Workbooks("Database.xls").ActiveSheet
.Rows(2).PasteSpecial _
Paste:=xlPasteValues
Range("B2").Select
.Columns("B:H").AutoFit
.Range("E:E,H:H").NumberFormat = "dd/mm/yyyy"
Range("B3").Select
End With
bk.Close savechanges:=False
End Sub


It's only selecting rows 2 and 3 at the end.
I really dont know what is wrong. Can you help me a little bit more?
Thanks!
 
P

puiuluipui

I have forgot to say that in Comenzi ANULATE 2009 i copy rows from active
sheet, because this sheet will chance, and i need to copy from active sheet.
This could be the problem?
Thanks!
 
J

Joel

You don't need to select to perform a copy with VBA. The selection is not
the problem. I guess the real problem is that the code isn't copying all the
rows you want. This can be caused by two reasons.

1) The LastRow variable is not correct. I'm using column G on the first tab
in the newly opened workbook. I'm also copying from the first tab in the
workbook. Maybe you want to change the line

from
With bk.Sheets(1)
to
With bk.Sheets("sheet1") or the appropriate sheet name


2) The Autofilter is not working correctly. I changed the data format to
d/m/yyyy instead of dd/mm/yyyy. I know the d/m/yyyy worked on my PC. A
problem that often happens in workbooks is some dates are really strings and
some dates are in Date format on the worksheet. It is hard to tell the
differences. What you may want to do is to manually open the source workbook
and do a autofilter on column G and see what happens.. If the filtering
isn't working then the problem is the dates aren't correct. Either they are
strings or maybe they are a combination of US date formates (Month/Day/Year)
and english formats (Day/Month/Year). I'm thinking this is the problem. You
can't mix the two date formats. If you are mixing US and English dates you
have to change one of them before mixing the data.


Note: The code always puts the data starting in row 2 on the destination
sheet. You may want to change the code to put the data at the end of the
worksheet instead of always at row 2.

I made some change below that may fix your problems. Not sure.

Sub COPY()
DateStr = Format(Date, "d/m/yyyy")
Set bk = Workbooks.Open(Filename:= _
"C:\Users\puiut\Desktop\login password\apollo\Comenzi ANULATE 2009.xls")

With bk.Sheets(1)
.Columns("G").NumberFormat = Format(Date, "d/m/yyyy")
LastRow = .Range("G" & Rows.Count).End(xlUp).Row
.Columns("G").AutoFilter
.Columns("G").AutoFilter Field:=1, _
Criteria1:=DateStr
.Rows("2:" & LastRow).SpecialCells( _
Type:=xlCellTypeVisible).COPY
End With

With Workbooks("Database.xls").ActiveSheet
.Rows(2).PasteSpecial _
Paste:=xlPasteValues
.Columns("B:H").AutoFit
.Range("E:E,H:H").NumberFormat = "dd/mm/yyyy"
.Range("B3").Select
End With
bk.Close savechanges:=False
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top