VBA code - copy info from sheet 1 to sheet 2 but NOT COPY BLANK CELLS

need some help please

I am creating a spreadsheet which records the time spent by staff carrying out certain tasks and runs reports so that management can see how much time is spent carrying out tasks by staff member or by task.

Sheet 1 I have tried to design as a user friendly sheet for staff to input their times, using drop down menus the user can find himself/ herself, find the task he/she has done and the manually input the time spend undertaking that work. with space in 4 rows (4-7) for up to 4 tasks to be added

There are 4 columns for this info
Date - cells D4-D7
Legal Adviser - cells E4-E7
Work Undertaken- cells F4-F7
Time- cells G4-G7

I have included a button in sheet 1 to copy the info in cells D4-G7 from sheet 1 to sheet 2 and then clear the data from those cells so that sheet 1 is blank again for the next user to input their data.

The problem I have is that the code will only copy the data if all 4 rows 4-7 are completed, whereas I want the code to copy only those rows which are completed and ignore any blank ones. So for example if the legal adviser has only carried out 2 types of work that day, and therefore only filled in rows D4-G4 and D5-G5, the code will only copy those rows onto sheet 2 and will not insist that all 4 rows be completed.

The code I currently have is:

Private Sub CommandButton1_Click()
Dim Day As Date, LegalAdviser As String, Work As String, Hours As String
Dim Day2 As Date, LegalAdviser2 As String, Work2 As String, Hours2 As String
Dim Day3 As Date, LegalAdviser3 As String, Work3 As String, Hours3 As String
Dim Day4 As Date, LegalAdviser4 As String, Work4 As String, Hours4 As String
Worksheets("sheet1").Select
Day = Format(CDate(Day), "dd/mm/yyyy")
Day = Range("D4")
LegalAdviser = Range("E4")
Work = Range("F4")
Hours = Range("G4")
Day2 = Format(CDate(Day), "dd/mm/yyyy")
Day2 = Range("D5")
LegalAdviser2 = Range("E5")
Work2 = Range("F5")
Hours2 = Range("G5")
Day3 = Format(CDate(Day), "dd/mm/yyyy")
Day3 = Range("D6")
LegalAdviser3 = Range("E6")
Work3 = Range("F6")
Hours3 = Range("G6")
Day4 = Format(CDate(Day), "dd/mm/yyyy")
Day4 = Range("D7")
LegalAdviser4 = Range("E7")
Work4 = Range("F7")
Hours4 = Range("G7")
Worksheets("sheet2").Select
Worksheets("sheet2").Range("A1").Select
If Worksheets("sheet2").Range("A1").Offset(1, 0) <> "" Then
Worksheets("sheet2").Range("A1").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Day
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = LegalAdviser
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Work
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Hours
ActiveCell.Offset(1, -3).Select
ActiveCell.Value = Day2
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = LegalAdviser2
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Work2
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Hours2
ActiveCell.Offset(1, -3).Select
ActiveCell.Value = Day3
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = LegalAdviser3
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Work3
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Hours3
ActiveCell.Offset(1, -3).Select
ActiveCell.Value = Day4
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = LegalAdviser4
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Work4
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Hours4
Worksheets("sheet1").Select
Worksheets("sheet1").Range("E4:G4").ClearContents
Worksheets("sheet1").Range("F5:G5").ClearContents
Worksheets("sheet1").Range("F6:G6").ClearContents
Worksheets("sheet1").Range("F7:G7").ClearContents
End Sub

I have fudged this through trial and error. Is there any way to tinker with this code so that it will ignore blank cells within the range of E4-G7 range?
Any help would be greatly appreciated
Thanks