Copy Value in next empty Column

[hkbhansali]

Hi,
I have record a macro and its work fine but I have one difficulty.
Can anyone please help me with some code to copy a column "E" and paste special Value it in the first empty column ("F") in a same worksheet.

Here is my Macro

[/I][/I]Sub Macro1()'
' Macro1 Macro
'


'
    Dim vFile As Variant


    'Showing Excel Open Dialog Form
    vFile = Application.GetOpenFilename("Excel Files (*.xlsx)," & _
    "*.xl*", 1, "Select Excel File", "Open", False)


    'If Cancel then exit
    If TypeName(vFile) = "Boolean" Then
        Exit Sub
    End If


    'Open selected file
    Workbooks.Open vFile
    Range("A1:M1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Nifty50Bhav.Activate
    Sheets("Bhav Copy").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("N1").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A1").Select
    Sheets("ind_nifty50list").Select
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "='Bhav Copy'!R[1]C[6]"
    Range("E3").Select
    Selection.FormulaArray = _
        "=INDEX('Bhav Copy'!R1C6:R3000C6,MATCH(RC[-2]&RC[-1],'Bhav Copy'!R1C2:R3000C2&'Bhav Copy'!R1C13:R3000C13,0))"
    Range("E3").Select
    Selection.Copy
    Range("E4:E100").Select
    ActiveSheet.Paste
    Range("F2").Select
    Application.CutCopyMode = False
    Range("A1").Select
End Sub


[I][I]

 

[frank_AL]

Hi,
I have record a macro and its work fine but I have one difficulty.
Can anyone please help me with some code to copy a column "E" and paste special Value it in the first empty column ("F") in a same worksheet.

Here is my Macro

Sub Macro1()'
' Macro1 Macro
'


'
    Dim vFile As Variant


    'Showing Excel Open Dialog Form
    vFile = Application.GetOpenFilename("Excel Files (*.xlsx)," & _
    "*.xl*", 1, "Select Excel File", "Open", False)


    'If Cancel then exit
    If TypeName(vFile) = "Boolean" Then
        Exit Sub
    End If


    'Open selected file
    Workbooks.Open vFile
    Range("A1:M1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Nifty50Bhav.Activate
    Sheets("Bhav Copy").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("N1").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A1").Select
    Sheets("ind_nifty50list").Select
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "='Bhav Copy'!R[1]C[6]"
    Range("E3").Select
    Selection.FormulaArray = _
        "=INDEX('Bhav Copy'!R1C6:R3000C6,MATCH(RC[-2]&RC[-1],'Bhav Copy'!R1C2:R3000C2&'Bhav Copy'!R1C13:R3000C13,0))"
    Range("E3").Select
    Selection.Copy
    Range("E4:E100").Select
    ActiveSheet.Paste
    Range("F2").Select
    Application.CutCopyMode = False
    Range("A1").Select
End Sub

After you copy the formula to Range(E4:E100) and Select Range("F2") you need to Copy the Selected Range and the Copy.

See modified code below:
Range("E4:E100").Select
ActiveSheet.Paste
Selection.Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

 

[hkbhansali]

Thanks frank_AL
Your Code Works fine But it's copy from cell E5:E100 and paste in Column F2:F100 so data mismatch

Sub Macro1() '' Macro1 Macro
'




'
    Dim vFile As Variant




    'Showing Excel Open Dialog Form
    vFile = Application.GetOpenFilename("Excel Files (*.xlsx)," & _
    "*.xl*", 1, "Select Excel File", "Open", False)




    'If Cancel then exit
    If TypeName(vFile) = "Boolean" Then
        Exit Sub
    End If




    'Open selected file
    Workbooks.Open vFile
    Range("A1:M1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Nifty50Bhav.Activate
    Sheets("Bhav Copy").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("N1").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A1").Select
    Sheets("ind_nifty50list").Select
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "='Bhav Copy'!R[1]C[6]"
    Range("E3").Select
    Selection.FormulaArray = _
        "=INDEX('Bhav Copy'!R1C6:R3000C6,MATCH(RC[-2]&RC[-1],'Bhav Copy'!R1C2:R3000C2&'Bhav Copy'!R1C13:R3000C13,0))"
    Range("E3").Select
    Selection.Copy
    Range("E4:E100").Select
    ActiveSheet.Paste
    Selection.Copy
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
End Sub

 

[frank_AL]

Yes, I thought of that after I went to bed last night! See modified code below. Added Line 3 & 4 to cancel CutCopy Mode and select E2:E100

Range("E4:E100").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("E2:E100").Select
Selection.Copy
Range("F2:F100").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

Here's another thing to think about. I don't like to hard code Row selection. I went with what you had since you know your spreadsheet and maybe the rows of data in Column E never change. However, If there is a chance that it might, consider using this code below to determine the lastrow and then incorporate that into your code. This method is much safer than Select End Down since that method will stop if there is a blank cell before the actual end of your data. It also ensures you aren't arbitrarily copy more rows than necessary.

Dim LastRow as Integer
LastRow = Cells(Rows.Count, "E").End(xlUp).Row
Range("E4:E" & LastRow).Select
Selection.Copy
Range("F2:F" & LastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select