Code Optimization - Copy cells from one sheet to another - remove blank rows

[snuffnchess]

While I was able to get code to work and do what it is I am wanting, something tells me that there are much better ways to do what I am trying to accomplish?

Essentially, I am wanting to copy the contents of cells from "ClientDB" BJ4:BK(lastrow), BN4:BO(lastrow) - and so on

and then have those contents paste only into column A and B of the Birthdays tab. Essentially I want to be able to enter in the month (for example May) and have an auto Filter of everybody whose birthday is that month.

To Copy the persons Name and DOB I am using:

[/COLOR]Sub Macro1()

Dim bd As Worksheet
Set bd = Worksheets("Birthdays")
Dim CDB As Worksheet
Set CDB = Worksheets("ClientDB")
Dim lastrow As Long
Dim lastbdrow As Long


With Sheets("Birthdays")
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lastbdrow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        lastbdrow = 1
    End If
End With


With Sheets("ClientDB")
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lastrow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        lastrow = 1
    End If
End With




    Dim bdRow As Long
    bdRow = Application.WorksheetFunction.CountA(bd.Range("A:A")) + 1
    
    Sheets("Birthdays").Select
    Range("A2:B" & lastrow).ClearContents
    
    
    


    Sheets("ClientDB").Select
    Range("BI4:BJ" & lastrow).Select
    Selection.Copy
    Sheets("Birthdays").Select
    Range("A2").Select
    bd.Cells(bdRow, 1).Select
    ActiveSheet.Paste
   ' Sheets("ClientDB").Select
   ' Range("BN4:BO4").Select
   ' Range(Selection, Selection.End(xlDown)).Select
   ' Selection.Copy
   ' bdRow = Application.WorksheetFunction.CountA(bd.Range("A:A")) + 1
   ' Sheets("Birthdays").Select
   ' bd.Cells(bdRow, 1).Select
   ' ActiveSheet.Paste

End Sub[COLOR=#333333]

And then to eliminate the blank rows I am using

[/COLOR]Sub Select_Blank_Rows()

Dim rRow As Range
Dim rSelect As Range
Dim rSelection As Range




Dim lastrow As Long


With Sheets("Birthdays")
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lastrow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        lastrow = 1
    End If
End With


'MsgBox lastrow


If Selection.Cells.Count = 1 Then
    Set rSelection = Range("A1:B" & lastrow)
    Else
    Set rSelection = Range("A1:B" & lastrow)
End If




  For Each rRow In rSelection.Rows
    If WorksheetFunction.CountA(rRow) = 0 Then
      If rSelect Is Nothing Then
        Set rSelect = rRow
      Else
        Set rSelect = Union(rSelect, rRow)
      End If
    End If
  Next rRow
  
  rSelect.Rows.Delete Shift:=xlShiftUp
  
  

End Sub[COLOR=#333333]

 

[Fluff]

Cross posted https://www.excelforum.com/excel-pr...m-one-sheet-to-another-remove-blank-rows.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[snuffnchess]

Cross posted https://www.excelforum.com/excel-pr...m-one-sheet-to-another-remove-blank-rows.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

Completely understood. I will make sure to do that going forward.