[问答] VBA 高手请进 [推广有奖]

3关注
9粉丝

已卖：1921份资源

博士生

20%

还不是VIP/贵宾

威望: 0 级
论坛币: 6005 个
通用积分: 12.2090
学术水平: 43 点
热心指数: 43 点
信用等级: 40 点
经验: 94521 点
帖子: 324
精华: 0
在线时间: 25 小时
注册时间: 2011-8-29
最后登录: 2025-5-7

楼主

lam_fukming 发表于 2013-6-28 21:11:41 |AI写论文

是否 +2 论坛币

k人参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

在不打开其他WORKBOOK的情况下, 请问如何把位于同一FILE里的所有WORKBOOK的某一张SHEET的所有内容(或一部分内容)都植入当前使用的WORKBOOK的不同SHEET

例如:

在路径"D:\Data\"下, 我有100个 EXCEL档案, 每个都有同一样的格式。

我想将每个 EXCEL档案内 Sheet1! A1:G20 的数据, 都复制到当前使用的WORKBOOK中,

而且要分做100个SHEET来存放, 而每张SHEET的名称要跟原来的 EXCEL文件名一样

下面是我写MACRO, 但是只能复制到每张SHEET的单一个数据格, 求高手帮忙修正。

加粗是我认为可能需要修改的地方。

Private Function GetInfoFromClosedFile(ByVal wbPath As String, wbName As String, wsName As String, cellRef As String) As Variant
  Dim arg As String
  GetInfoFromClosedFile = ""
  If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
  If Dir(wbPath & "\" & wbName) = "" Then Exit Function
  arg = "'" & wbPath & "[" & wbName & "]" & wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
  On Error Resume Next
  GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function

Sub ReadDataFromAllWorkbooksInFolder()
  Dim FolderName As String, wbName As String, r As Long, cValue As Variant
  Dim wbList() As String, wbCount As Integer, i As Integer
  FolderName = "D:\Data\"
  wbCount = 0
  wbName = Dir(FolderName & "\" & "*.xls")
  While wbName <> ""
wbCount = wbCount + 1
ReDim Preserve wbList(1 To wbCount)
wbList(wbCount) = wbName
wbName = Dir
  Wend
  If wbCount = 0 Then Exit Sub

  'Extract data from all workbooks
  Dim newsheet As Worksheet
  r = 0
  Workbooks.Add
  For i = 1 To wbCount
Set newsheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
newsheet.Name = wbList(i)
r = r + 1
cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Sheet1", "A1")
Cells(1, 1).Formula = cValue
  Next i
End Sub