Ctrl-Shift-Down Alternative

[JoshuaZeno]

This code currently copies and pastes a set of policies from one spreadsheet to another based on CTRL-SHIFT-DOWN. There are some empty rows between filled rows, so this method does not copy policies listed below the blank row if using the CTRL-SHIFT-DOWN method. What code can I alter to copy and paste all the rows regardless of blank rows inbetween filled rows?


Sub ImportData()

Range("D6") = "Running"
Application.Calculation = xlManual
Application.ScreenUpdating = False

Dim summary As Workbook
Set summary = ThisWorkbook

Dim source As Workbook

Dim Location As String
Location = Worksheets("Macro").Range("D5") + Worksheets("Macro").Range("E5")

Dim sourceName As String
sourceName = Worksheets("Macro").Range("E5")

Dim month As String
month = Worksheets("Macro").Range("C5")

'If no such file, message "Input file does not exist."
If Dir(Location) <> "" Then

Sheets(month).Select
Range("AG:AK").Select
Selection.ClearContents
LastRow = ActiveSheet.UsedRange.Rows.Count
LastCol = ActiveSheet.UsedRange.Columns.Count
'Range("K3", Cells(LastRow, LastCol).Address(False, False)).Select
'Selection.ClearContents
Range("A1").Select

'Opens file if not already opened
On Error Resume Next
Set source = Workbooks(sourceName)
If Err.Number > 0 Or Err.Number < 0 Then
Err.Clear
IsClosed = 1
Set source = Workbooks.Open(Location)
End If

source.Worksheets("Data").Activate
source.Worksheets("Data").Range("AZ:BB, BD:BG").Copy
'source.Worksheets("Data").Range("BD:BG").Copy
Application.Goto Reference:="Data"

summary.Activate
Sheets(month).Select
'Range("A2").Select
'ActiveSheet.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Range("AG1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Range("AG1").Select

Sheets(month).Select
Range("AG2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("IFT").Select
'Range("A3").Select
If month = "Jan" Then
Range("A3").Select
ElseIf month = "Feb" Then
Range("H3").Select
ElseIf month = "Mar" Then
Range("O3").Select
ElseIf month = "Apr" Then
Range("V3").Select
ElseIf month = "May" Then
Range("AC3").Select
ElseIf month = "Jun" Then
Range("AJ3").Select
ElseIf month = "Jul" Then
Range("AQ3").Select
ElseIf month = "Aug" Then
Range("AX3").Select
ElseIf month = "Sep" Then
Range("BE3").Select
ElseIf month = "Oct" Then
Range("BK3").Select
ElseIf month = "Nov" Then
Range("BS3").Select
ElseIf month = "Dec" Then
Range("BZ3").Select
End If

ActiveSheet.Paste
Sheets(month).Select
Range("AG1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Sheets(month).Select
Range("AA2:AF2").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Selection.AutoFill Destination:=Range("AA2:AF" & LastRow)
Range("AA3:AF" & LastRow).Select
Selection.Font.ColorIndex = 0
Selection.Font.Bold = False
Selection.Interior.Pattern = xlNone
Selection.Interior.TintAndShade = 0
Selection.Interior.PatternTintAndShade = 0
Range("A1").Select

'Closes if opened
If IsClosed = 1 Then
source.Close savechanges:=False
End If
IsClosed = 0

'Else
'MsgBox "Input file does not exist"
'End
End If

Sheets("Macro").Select
Range("A1").Select

Range("D6") = ""
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

End Sub

 

[Fluff]

Duplicate to: Copy Macro from Bottom to Top

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.