3

I am trying to pull a file-(1) inside a excel file(2) by browsing in my computer. And pull data from the file-(1) from different cells randomly and paste it in file(2).
I am beginner and trying to copy bits and parts from different program to make it work.I have complied a code that works okay.

I face some problem. a) As I am copying and pasting each cell one by one the program is too long and my screen flashes white many times. (I tried Application.EnableEvents = False but it didn't work. May be I don't know where to insert it exactly)

b) can it be done once I copy the data from file(1) Inside file(2), Can the file(1) be closed(or loose from browse link).

c)can the code be made short ? (like copying together and pasting together etc).I have to copy data from 10 more cells. 

Sub PullData() Dim uploadfile As Variant Dim uploader As Workbook Dim CurrentBook As Workbook Set CurrentBook = ActiveWorkbook MsgBox ("Please select uploader file to be reviewed") uploadfile = Application.GetOpenFilename() If uploadfile = "False" Then Exit Sub End If Workbooks.Open uploadfile Set uploader = ActiveWorkbook With uploader Application.CutCopyMode = False Range("L10").Copy End With CurrentBook.Activate Sheets("Calculations").Range("AO29").PasteSpecial Paste:=xlPasteValues Workbooks.Open uploadfile Set uploader = ActiveWorkbook With uploader Application.CutCopyMode = False Range("L11").Copy End With CurrentBook.Activate Sheets("Calculations").Range("AO26").PasteSpecial Paste:=xlPasteValues Workbooks.Open uploadfile Set uploader = ActiveWorkbook With uploader Application.CutCopyMode = False Range("H24").Copy End With CurrentBook.Activate Sheets("Calculations").Range("AO13").PasteSpecial Paste:=xlPasteValues Workbooks.Open uploadfile Set uploader = ActiveWorkbook With uploader Application.CutCopyMode = False Range("H27").Copy End With CurrentBook.Activate Sheets("Calculations").Range("AO18").PasteSpecial Paste:=xlPasteValues Workbooks.Open uploadfile Set uploader = ActiveWorkbook With uploader Application.CutCopyMode = False Range("H26").Copy End With CurrentBook.Activate Sheets("Calculations").Range("AO17").PasteSpecial Paste:=xlPasteValues Workbooks.Open uploadfile Set uploader = ActiveWorkbook With uploader Application.CutCopyMode = False Range("L9").Copy End With CurrentBook.Activate Sheets("Calculations").Range("AO25").PasteSpecial Paste:=xlPasteValues Workbooks.Open uploadfile Set uploader = ActiveWorkbook With uploader Application.CutCopyMode = False Range("E42").Copy End With CurrentBook.Activate Sheets("Calculations").Range("AO34").PasteSpecial Paste:=xlPasteValues Workbooks.Open uploadfile Set uploader = ActiveWorkbook With uploader Application.CutCopyMode = False Range("E43").Copy End With CurrentBook.Activate Sheets("Calculations").Range("AO33").PasteSpecial Paste:=xlPasteValues Workbooks.Open uploadfile Set uploader = ActiveWorkbook With uploader Application.CutCopyMode = False Range("E48").Copy End With CurrentBook.Activate Sheets("Calculations").Range("AO45").PasteSpecial Paste:=xlPasteValues Workbooks.Open uploadfile Set uploader = ActiveWorkbook With uploader Application.CutCopyMode = False Range("E50").Copy End With CurrentBook.Activate Sheets("Calculations").Range("AO44").PasteSpecial Paste:=xlPasteValues End Sub
Improve this question
4
  • 1
    Try Application.screenupdating = False and yes, you can set ranges to each other instead of copy/pasting. Commented Jun 2, 2016 at 19:27
  • 1
    Also, to use the With statement change Range... to .Worksheets("WorksheetName").Range... The With statement removes the need to retype objects. Commented Jun 2, 2016 at 19:30
  • @ findwindow thanks for the help I tried Application.screenupdating = false in the beginning before copying starts. and Application.screenupdating = True before End Sub. but it doesn't work. Screen keeps flashing. Do I have to write it before every copy? @Brian thank you for the help is it possible to write a small example code for me, copying two cell and pasting it. I can try to make it work from there. I am not from coding background and my coding literacy is 1/10. I couldn't understand what does the comment mean. Commented Jun 2, 2016 at 19:50
  • @Eric - the screen keeps flashing because you keep opening the same workbook, then activating and selecting multiple workbooks. See my answer below for an clean and working solution. Commented Jun 2, 2016 at 20:06

2 Answers 2

Reset to default
1

This will help you a lot:

Sub PullData() Dim uploadfile As Variant Dim uploader As Workbook Dim CurrentBook As Workbook Application.ScreenUpdating = False Set CurrentBook = ThisWorkbook 'refers to workbook with code MsgBox ("Please select uploader file to be reviewed") uploadfile = Application.GetOpenFilename() If uploadfile = "False" Then Exit Sub Set uploader = Workbooks.Open(uploadfile) 'stay away from ActiveWorkbook AMAP With CurrentBook.Sheets("Calculations") .Range("AO29").Value = uploader.Sheets(1).Range("L10").Value .Range("AO26").Value = uploader.Sheets(1).Range("L11").Value .Range("AO13").Value = uploader.Sheets(1).Range("H24").Value 'add the rest of your references here End With uploader.close savechanges:=false End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

4 Comments

Thank you scott. Somehow I got error in line - set uploader = workbook.open uploadfile .
@Eric - fixed it. Sorry. Forgot the parenthesis when setting the object.
Great it worked at that part. But now it is show error in copy and paste line. The file(1)has 6 tabs/sheets, that is opened in sheet 1 of file(2) and pulling the value in "calculations" which is 2nd tab of file(2). is that error coming due to 6 tabs in the file?
@Eric - you can change the Sheets(1) reference to Sheets("mySheetName") to be more specific in pulling from the exact sheet from the uploader workbook. I used Sheets(1) since you didn't specify in your code which sheet, so I assumed it only had one.
0

Here is a much simplified version of what you're doing, that actually picks random cells every time.

Sub PullData() Dim lngCount As Long Dim lngRow As Long Dim lngSrcRow As Long Dim lngSrcCol As Long Dim uploadfile As Variant Dim uploader As Workbook Dim CurrentBook As Workbook Set CurrentBook = ActiveWorkbook MsgBox ("Please select uploader file to be reviewed") uploadfile = Application.GetOpenFilename() If uploadfile = "False" Then Exit Sub End If Application.ScreenUpdating = False Set uploader = Workbooks.Open uploadfile For lngCount = 1 To 10 Do While True lngRow = Abs(lngRow + Application.WorksheetFunction.RandBetween(-5, 10)) If lngRow = 0 Then lngRow = lngRow + 1 If IsEmpty(CurrentBook.Sheets("Sheet1").Range("A" & lngRow)) Then Exit Do Loop lngSrcRow = Application.WorksheetFunction.RandBetween(1, ActiveSheet.UsedRange.Rows.Count) lngSrcCol = Application.WorksheetFunction.RandBetween(1, ActiveSheet.UsedRange.Columns.Count) CurrentBook.Worksheets("Calculations").Range("AO" & lngRow).Value = ActiveSheet.Cells(lngSrcRow, lngSrcCol).Value Next lngCount Application.ScreenUpdating = True Application.CutCopyMode = False uploader.close savechanges:=false End Sub
Improve this answer

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.