VBA复制粘贴多个工作簿中的选定单元格 [英] VBA Copy Paste selected cell from multiple workbooks

问题描述

早上，

我对VBA很新，可以通过让计算机记录我的动作来使用宏。

我正在尝试创建一个excel仪表板。此仪表板将在开始时包含一个摘要表，然后是各种选项卡（标题为业务中的每个实体......法国，巴西等）。

我想做的是，有这些标签（经过实体授权的标签，每周更新一次。 我将发送一个只包含公告的主工作簿工作表的副本。

我希望能够做的是将手动数据复制并粘贴到正确的实体选项卡中，以便汇总所有公式表格永远不必改变等等。

我打算将所有文件放入一个文件夹，以便复制和粘贴相同范围的单元格（3different范围）B22 ：& 46，B69：J71和B75：J77。

工作表的其余部分是公式，例如= sum（BXX：BYY）等。

我可以使用VBA来做这件事吗？

解决方案

你好
InzieBear，

我试着查看你的要求。

我从中理解的是，

有一个w该第一张表中的orkbook是"摘要"。表。

还有其他一些国家/地区名称。

您希望每周更新这些国家/地区表。

您曾提到过，"我希望能够做的是将手动数据复制并粘贴到正确的实体标签中，以便汇总表的所有公式都不必更改等等"

然后你提到过，"我打算将所有文件放到一个文件夹中，这样就可以复制并粘贴相同范围的单元格（3different range）B22：& 46，B69 ：J71和B75：J77。"

所以这里看起来你想要将范围从一个工作簿复制到另一个工作簿。

请参考以下示例。

 Sub demo（）
 Dim x As Workbook 
 Dim y As Workbook 
 Set x = Workbooks.Open （"C：\ Users \ -v-padee \Desktop\excel files\source.xlsx""）
设置y = Workbooks.Open（" C：\ Users \v-padee \Desktop\excel files\target.xlsx& ";"
 y.Sheets（" Sheet1"）。范围（" A1"）。Value = x.Sheets（" Sheet1"）。范围（" A1"）
 x。关闭
结束子
 

在示例中，您可以看到值是直接分配的。您也可以使用复制和粘贴。

然后我可以看到您正在一个文件夹中使用多个文件执行此操作。

所以你需要循环浏览文件夹中的这些文件。

你可以参考下面的例子。

 
 Sub LoopAllExcelFilesInFolder（）
'目的：遍历用户指定文件夹中的所有Excel文件，并对它们执行设置任务
'来源：www.TheSpreadsheetGuru.com 
 
 Dim wb作为工作簿
 Dim myPath As String 
 Dim myFile As String 
 Dim myExtension As String 
 Dim FldrPicker As FileDialog 
 
'优化宏速度
 Application.ScreenUpdating = False 
 Application.EnableEvents = False 
 Application.Calculation = xlCalculationManual 
 
'从用户检索目标文件夹路径
设置FldrPicker = Application.FileDialog（msoFileDialogFolderPicker ）
 
使用FldrPicker 
。标题="选择目标文件夹&qu OT; 
 .AllowMultiSelect = False 
如果.Show<> -1然后GoTo NextCode 
 myPath = .SelectedItems（1）& " \" 
结束时
 
'如果取消
 NextCode：
 myPath = myPath 
如果myPath =""然后GoTo重置设置
 
'目标文件扩展名（必须包含通配符" *"）
 myExtension =" * .xls *" 
 
'结束扩展的目标路径
 myFile = Dir（myPath& myExtension）
 
'遍历文件夹中的每个Excel文件
 Do While myFile <> "" 
'设置变量等于已打开的工作簿
设置wb = Workbooks.Open（文件名：= myPath& myFile）
 
'确保工作簿已打开，然后再转到下一行代码
 DoEvents 
 
'更改第一工作表的背景填充蓝色
 wb.Worksheets（1）.Range（" A1：Z1"）。Interior.Color = RGB（51， 98,174）
 
'保存并关闭工作簿
 wb.Close SaveChanges：= True 
 
'确保工作簿已关闭，然后再转到下一行代码
 DoEvents 
 
'获取下一个文件名
 myFile = Dir 
循环
 
'任务完成时的消息框
 MsgBox" ;任务完成！" 
 
 ResetSettings：
'重置宏优化设置
 Application.EnableEvents = True 
 Application.Calculation = xlCalculationAutomatic 
 Application.ScreenUpdating = True 
 
结束次级
 

参考：

遍历给定文件夹中的所有Excel文件

您需要合并两个代码以满足您的要求。所以根据你的需要进行修改。

问候

Deepak

Morning,

Im pretty new to VBA, and can use macro by letting the computer record my movements.

Im trying to create an excel dashboard. This dashboard will contain A Summary Sheet at the start followed by various tabs (titled after each entity in the business..ie France, Brazil... etc).

What I want to do, is have these tabs (the ones entitled after entity, to be updated weekly.  I will send out a master workbook that will contain just a copy of the worksheet.

What I want to be able to do, is copy and paste the manual data into the correct entitys tab so that all the formulas for the summary sheet never have to change etc.

I plan on putting all the files into one folder so its a case of copying and pasting the same range of cells (3different ranges) B22:&46, B69:J71 and B75:J77.

The rest of the worksheet is formula such as =sum(BXX:BYY) etc.

Is there a VBA I can use to do this?

解决方案

Hi InzieBear,

I try to look in to your requirement.

what I understand from that,

there is one workbook in that first sheet is "Summary" sheet.

there are some other sheets with country names.

you want to update these country sheets weekly.

you had mentioned that,"What I want to be able to do, is copy and paste the manual data into the correct entitys tab so that all the formulas for the summary sheet never have to change etc."

then you had mentioned ,"I plan on putting all the files into one folder so its a case of copying and pasting the same range of cells (3different ranges) B22:&46, B69:J71 and B75:J77."

so here it looks like you want to copy the range from one workbook to another.

please refer the example below.

Sub demo()
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks.Open("C:\Users\v-padee\Desktop\excel files\source.xlsx")
Set y = Workbooks.Open("C:\Users\v-padee\Desktop\excel files\target.xlsx")
y.Sheets("Sheet1").Range("A1").Value = x.Sheets("Sheet1").Range("A1")
x.Close
End Sub

here in the example you can see that values are directly assigned. you can also use to copy and paste.

then I can see that you are performing this operation with multiple files in one folder.

so you need to loop through this files in folder.

for that you can refer the example below.

Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
    'Change First Worksheet's Background Fill Blue
      wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
    
    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Reference:

Loop Through All Excel Files In A Given Folder

you need to merge both the code to fulfil your requirement. so modify it as per your need.

Regards

Deepak

这篇关于VBA复制粘贴多个工作簿中的选定单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！