从单个工作簿中的多个工作簿的多个工作表中提取数据 [英] Pulling Data from Multiple Worksheets of Multiple Workbooks in a Single Workbook

问题描述

亲爱的，

当天的问候.. !!!

我正在寻找以下要求的宏。

文件夹中有多个工作簿，所有工作簿都有多个包含数据的工作表。例如，

在1个工作表（EMP信息） 

员工姓名：	XXX					GRADE：		XXX
员工编号：	XXXX					DESIGNATION：		XXX
位置：	XXX					DOJ（DD / MM / YYYY）：		XXX
DEPARTMENT：	XXX					FOR THE PERIOD：		XXX
经理姓名：	XXX								 

在2工作表中（目标评论） 

需要从单元格中提取数据  J16到J31

所有数据都应采用此COLUMN明智格式

员工姓名  员工没有 部门 经理姓名..............

XXXX                        XXXX                XXXX              XXXX ........

YYYY                        YYYY                  YYYY                YYYY ........

请帮我解决宏

在此先感谢。

-Anvesh

解决方案

嗨
Anvesh Mudhamalle，

首先尝试将您的整个需求分成几个部分，然后尝试实现每个部分 

（1）遍历文件夹中的所有工作簿。

选项显式
 
 Sub LoopAllExcelFilesInFolder（）
'目的：循环用户指定文件夹中的所有Excel文件并执行一组他们的任务
'来源：www.TheSpreadsheetGuru.com 
 
 Dim wb As Workbook 
 Dim myPath As String 
 Dim myFile As String 
 Dim myExtension As String 
 Dim FldrPicker As FileDialog 
 
'优化宏速度
 Application.ScreenUpdating = False 
 Application.EnableEvent s = False 
 Application.Calculation = xlCalculationManual 
 
'从用户检索目标文件夹路径
设置FldrPicker = Application.FileDialog（msoFileDialogFolderPicker）
 
使用FldrPicker 
。标题="选择目标文件夹" 
 .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文件

（2）遍历单个工作簿中的所有工作表。

所以在从上面提到的代码打开一个工作簿之后，你需要执行下面的代码来遍历所有工作表。

 Sub WorksheetLoop（）
 
 Dim WS_Count As Integer 
 Dim I As Integer 
 
'设置WS_Count等于活动
'工作簿中的工作表数量。 
 WS_Count = ActiveWorkbook.Worksheets.Count 
 
'开始循环。 
 For I = 1 To WS_Count 
 
'在此处插入您的代码。 
'以下行显示如何通过在对话框中显示工作表名称来引用
'循环中的工作表。 
 MsgBox ActiveWorkbook.Worksheets（I）.Name 
 
下一个I 
 
结束子

参考：

宏以遍历工作簿中的所有工作表

遍历所有当前打开的工作簿中的所有工作表

（3）然后在激活一个工作表后，您需要再次遍历"J"列中的所有行，从16到31。

 Sub demo（ ）
 Dim i As Long 
 Columns（1）.Font.Color = vbBlack 
 For i = 1 To Rows.Count 
 If Cells（i，1）.Value<范围（"D2"）。值和非IsEmpty（Cells（i，1）.Value）然后
 Cells（i，1）.Font.Color = vbRed 
结束如果
下一步i 
 End Sub 

参考：

浏览整个列

这里指定了范围，因此您需要使用For each循环和循环遍历该范围。

在Excel范围内使用For Each / p>

（4）然后在循环中，您需要将每个单元格中的数据复制到当前工作簿。

因此您需要创建一个对象当前工作簿和复制粘贴数据循环。

类似下面的内容。

工作簿（"Book2.xlsx"）。工作表（"Sheet1"）。范围（"A1"）。值= _ 
工作簿（"Book1.xlsx"）。工作表（" Sheet1"）。范围（" A1"）。值

使用VBA宏+视频复制和粘贴单元格的3种方法

因此您只需要将所有代码块合并为一个并根据您的要求进行修改。

问候

Deepak

Dear all,

Greetings of the day..!!!

I m looking for a macro for the below requirement.

There are multiple workbooks in a Folder, all workbooks have multiple worksheets which contains data.
for example

In 1 worksheet (EMP Information) 

EMPLOYEE NAME :	XXX					GRADE:		XXX
EMPLOYEE NO:	XXXX					DESIGNATION:		XXX
LOCATION:	XXX					DOJ(DD/MM/YYYY):		XXX
DEPARTMENT:	​XXX					FOR THE PERIOD:		XXX
MANAGER'S NAME:	XXX

In 2 worksheet (Goals Review) 

need to pull the data from the cell  J16 to J31

All the Data should be in this COLUMN wise format

EMPLOYEE NAME   EMPLOYEE NO  DEPARTMENT   MANAGER NAME ..............

XXXX                        XXXX                 XXXX               XXXX ........

YYYY                         YYYY                  YYYY                YYYY........

Please help me out with macro

Thanks in Advance.

-Anvesh

解决方案

Hi Anvesh Mudhamalle,

first try to divide your whole requirement in several parts and then try to achieve each part 

(1) loop through all workbooks in folder.

Option Explicit

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

(2) Loop through all worksheets in single workbook.

so after opening one workbook from code mentioned above you need to execute code below to loop through all worksheets.

Sub WorksheetLoop()

         Dim WS_Count As Integer
         Dim I As Integer

         ' Set WS_Count equal to the number of worksheets in the active
         ' workbook.
         WS_Count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 1 To WS_Count

            ' Insert your code here.
            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
            MsgBox ActiveWorkbook.Worksheets(I).Name

         Next I

      End Sub

Reference:

Macro to Loop Through All Worksheets in a Workbook

Loop Through All Worksheets In All Currently Open Workbooks

(3) then after activating the one worksheet you need to again loop through all the rows in column "J" from 16 to 31.

Sub demo()
Dim i As Long
Columns(1).Font.Color = vbBlack
For i = 1 To Rows.Count
If Cells(i, 1).Value < Range("D2").Value And Not IsEmpty(Cells(i, 1).Value) Then
     Cells(i, 1).Font.Color = vbRed
End If
Next i
End Sub

Reference:

Loop through Entire Column

here you have specified range , so you need to use For each loop and loop through that range.

Using For Each in Excel range

(4) then in loop , you need to copy the data from each cell to current workbook.

so you need to make an object of your current workbook and copy paste data in loop.

something like below.

  Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("A1").Value = _
        Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Value

3 Ways to Copy and Paste Cells with VBA Macros + Video

so you just need to combine these all code blocks in to one and modify it as per your requirement.

Regards

Deepak

这篇关于从单个工作簿中的多个工作簿的多个工作表中提取数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！