I am trying to copy entire rows onto a new worksheet, but only copy those rows where a childs age is above 20.
I have not yet written the If statements to select these rows, but have written code to import the data and fill in various columns in order to get the 20th birthday from the birth date.
My problem is that the cells in the columns that are on the imported worksheet are merged. This is merged because one person may have more than one child, so in this case, the cells regarding the parent are merged. It won't let me copy the merged cells.
For now I'm just trying to work out how to copy the entire sheet just so I know how to copy merged cells, before doing the If statement.
This is what I have so far (bold bit at bottom is where I'm trying to copy merged cells. I'm getting an error on the line with ActiveSheet.Range("**").MergeArea.Copy
Option Explicit
Sub ImportActiveList()
Dim FileName As String
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim ActiveListWB As Workbook
Set WS2 = ActiveWorkbook.Sheets("Sheet1")
FileName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _
Title:="Select Active List to Import", _
MultiSelect:=False)
If FileName = "False" Then
Exit Sub
Else
Set ActiveListWB = Workbooks.Open(FileName)
End If
Set WS1 = ActiveListWB.Sheets("Page1-1")
WS1.UsedRange.Copy WS2.Range("A1")
ActiveWorkbook.Close False
End Sub
Sub CalculateBirthday()
Dim lastrow As Long
lastrow = Range("X" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("A5:AA291").AutoFilter
ActiveSheet.Range("$A$5:$AA$291").AutoFilter Field:=24, Criteria1:="Child"
Range("AB5") = "Today's Age Year/Month"
Range("AB7:AB" & lastrow).Formula = "=DATEDIF(RC[-2],TODAY(),""Y"") & "" Years, "" & DATEDIF(RC[-2],TODAY(),""YM"") & "" Months """
Columns("AB:AB").EntireColumn.AutoFit
Range("AC5") = "Today's Age Year Only"
Range("AC7:AC" & lastrow).Formula = "=DATEDIF(RC[-3],TODAY(),""Y"")"
Columns("AC:AC").EntireColumn.AutoFit
Range("AD5") = "Child 20th Birthday"
Range("AD7:AD" & lastrow).Formula = "=DATE(YEAR(R[-1]C[-4])+20, MONTH(R[-1]C[-4]),DAY(R[-1]C[-4]))"
Columns("AD:AD").EntireColumn.AutoFit
ActiveSheet.Range("A5:AA291").MergeArea.Copy 'copies the merged cells
Sheet2.Range("A1").PasteValues ' pastes what was copied into A1 on Sheet 2 and any merged cells**
End Sub
Range("A5").Copy
sheet2.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.