Ctrl-Shift-Down Alternative

Status
Not open for further replies.

JoshuaZeno

New Member
Joined
Mar 9, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,562
Office Version
  1. 365
Platform
  1. Windows
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.
 
Status
Not open for further replies.

Watch MrExcel Video

Forum statistics

Threads
1,129,594
Messages
5,637,299
Members
416,963
Latest member
zazama

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top