Copy in a new sheeet, rows that have a certain date in them

[daniels012]

Using code:
How can I copy rows that have specific dates from a sheet named "Total" to the current sheet I am in?

Rather than manually copying and pasting, it would be much easier if I could do it using code.

Any Ideas?

Michael

 

[kmiles]

The following assumes Total!A:A is formatted as date and that you have the destination worksheet selected when you run this sub. Change the "if" to reflect whatever dates you need.

Sub copy_rows_by_dates()

Dim c As Range, ws As Worksheet

Set ws = Worksheets("Total")

For Each c In ws.Range("A:A")
If c.Value <= "12/18/2005" Then
c.EntireRow.Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next

End Sub

 

[daniels012]

Thank you for responding!!!

HOw can I modify what you have given to get the date I would like? Below is code I have to create a new sheet based with info in cell E1. I would like to implement the info you have given to include this.

Sub create_sheet() 
Dim ShName As String 
Dim ShExists As Boolean 

ShName = Sheets("Sheet1").Range("E1").Text 

On Error Resume Next 
ShExists = Len(Worksheets(ShName).Name) > 0 
On Error GoTo 0 

    If ShExists Then 
    MsgBox "Worksheet already exists", 48, "Title" 
    Else 
    ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count) 
    ActiveSheet.Name = ShName 
    End If 
    
End Sub

I want to copy data from the Total Worksheet to the newly created sheet based on the date in cell E1. Can I just add your code somewhere in mine?

I am very weak in code writing,
Michael

 

[daniels012]

Does this look as if it will work?

Sub create_sheet()
Dim ShName As String
Dim ShExists As Boolean
Dim c As Range, ws As Worksheet

ShName = Sheets("Sheet1").Range("E1").Text

On Error Resume Next
ShExists = Len(Worksheets(ShName).Name) > 0
On Error GoTo 0

If ShExists Then
MsgBox "Worksheet already exists", 48, "Title"
Else
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = ShName
End If


Set ws = Worksheets("Runnning Total")

For Each c In ws.Range("K:K")
If c.Value <= "12/18/2005" Then (I need it to enter date from last month)
c.EntireRow.Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next

I have a formula in cell E1 of the "Running Total sheet" that works for the date: =TEXT(TODAY()-DAY(TODAY())-1,"MMMM"&" "&"YYYY")

 

[kmiles]

Are you saying the dates you are comparing are in column K and you want to compare against the date in cell E1?

If so, your code should work except change e1 to another cell with just =today() in it (you can hide if need be) to make the IF statement valid.

If still confused, posting a small sample of your data with the cells in question would be helpful.

 

[daniels012]

Anyone?

Michael

 

[kmiles]

Post sample data if you need more help.

 

[daniels012]

I am sorry, let me be clearer. I need to copy all lines that have last months dates. My code creates a new sheet just fine. I need it to copy just the rows from the previous month into this new sheet. So instead of "12/18/2005" in your example, I need something like "today's month minus one" or something in a cell that I can refer to and put this in place of your "12/18/2005".

If c.Value <= "12/18/2005" Then (I need it to enter date from last month)

Does that make more sense?

Michael

 

[daniels012]

I forgot you wanted me to post what I have in E1

Cell E1 has : =TEXT(TODAY()-DAY(TODAY())-1,"MMMM"&" "&"YYYY")

Michael

 

[daniels012]

I tried this, with no luck It copied nothing?

Sub MakeNewMonthSheet()
    Dim ShName As String
    Dim ShExists As Boolean

    ShName = Sheets("Running Total").Range("E1").Text

    On Error Resume Next
    ShExists = Len(Worksheets(ShName).Name) > 0
    On Error GoTo 0

    If ShExists Then
    MsgBox "Worksheet already exists", 48, "Title"
    Else
    ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = ShName
    End If
    
    Dim c As Range, ws As Worksheet
    
    Set ws = Worksheets("Running Total")

    For Each c In ws.Range("K:K")
    If c.Value = "month(E1)" Then
    c.EntireRow.Copy
    ActiveSheet.Paste
    ActiveCell.Offset(1, 0).Select
    End If
    Next
End Sub