excel - 从一个文件中随机复制数据，然后使用宏将其随机粘贴到其他 Excel 中

Question

我试图通过在我的计算机中浏览来提取 Excel 文件 (2) 内的文件 -(1)。并从文件(1)的不同单元格中随机提取数据并将其粘贴到文件(2)中。
我是初学者，试图从不同的程序中复制一些片段以使其工作。我编写了一个可以正常工作的代码。

我遇到一些问题。 a)当我逐个复制和粘贴每个单元格时，程序太长，并且我的屏幕多次闪烁白色。 (我尝试了 Application.EnableEvents = False 但它不起作用。可能是我不知道在哪里准确插入它)

b)一旦我将文件(1)中的数据复制到文件(2)内，就可以完成吗？文件(1)可以关闭(或从浏览链接中松开)吗？

c) 代码可以缩短吗？ (例如复制在一起和粘贴在一起等)。我必须从另外 10 个单元格复制数据。

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

Answer 1

这会对你有很大帮助:

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