从共享文件夹上的另一个 Excel 工作簿复制并粘贴到同一文件夹

2024-04-16

请告诉我以下问题,我已经为此工作了 3 个月,但我无法理解它。

我必须解释整个项目,以便您能够理解我希望我的代码做什么:

我创建了一个用于数据输入的用户表单,它将由 3 个用户同时使用,PC 上的每个用户都有相同的 Excel 工作簿“ENTRY APPLICATION”,并且数据输入到名为“NEW ROUND”的工作表中每个用户数据例如,条目的序列号以 1 - 1000 开头。共享文件夹中的另一个工作簿将 3 个用户输入的所有数据复制并粘贴到共享工作簿“DATABASE”上,然后将“DATABASE”上收集的数据再次复制并粘贴到同一工作簿上” ENTRY APPLICATION”用于用户,但在另一张表中,以便在排序时镜像到用户的共享工作簿,以便为每个用户正确排序数据的序列号,因为我为 3 个用户拥有相同的工作簿,但每个用户都有相同的工作簿只是更改了他们的范围,以便将他们的数据复制到一个范围内,这样他们就不会清除其他用户数据条目,例如:用户1粘贴范围A1:N2000,用户2粘贴范围是A2001:N4000,用户3焊膏范围为A4001:N6000 然后,当再次粘贴到带有用户表单的“数据应用程序”工作簿时,它们都会被整理出来。

“数据库”工作簿是所有收集的数据都在其中的共享,以防止用户重复输入(位于不同的模块中),但现在我的困难是我试图用更少的时间和更高效的方式完成这项工作这样我就不必一直使用屏幕更新和打开激活保存关闭工作簿,这可能会使工作变慢并可能崩溃。

我现在在这里阅读了一篇关于父对象的精彩帖子,这显然为我的相同需求节省了大量时间和错误,但我不知道如何在我的用户表单工作簿上反映这一点以及如何调整我的代码。

请帮助我调整我的代码,希望我已经正确解释了。

Sub DATA_BASE_ARCHIVE_FullArchive()

Application.ScreenUpdating = False

Windows("ENTRY APPLICATION.xlsm").Activate
Sheets("NEWROUND").Select
Range("A1:N2000").Select

Selection.Copy

Workbooks.Open filename:= _
    "\\2-2023\DATABASE.xlsm"
Windows("DATABASE.xlsm").Activate
Range("A2001").Select
Sheets("FullArchive").Paste
Cells.Select
Range("A2001").Activate
Application.CutCopyMode = False
Selection.Copy


Windows("ENTRY APPLICATION.xlsm").Activate
Sheets("ARCHIVE").Select

Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("ARCHIVE").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ARCHIVE").Sort.SortFields.ADD Key:=Columns("L:L") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ARCHIVE").Sort.SortFields.ADD Key:=Columns("A:A") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ARCHIVE").Sort
    .SetRange Columns("A:P")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


Windows("DATABASE.xlsm").Activate
ActiveWorkbook.Save
ActiveWindow.Close
Application.CutCopyMode = False
Windows("ENTRY APPLICATION.xlsm").Activate
Sheets("FORM").Select
End Sub

请原谅我复杂的解释,但我想做的事情已经够复杂的了!所以请帮忙。谢谢。

我根据从@stringeater收到的第一个答案编辑了代码。请检查一下并帮助我下一步要调整什么。我现在刚刚收到一个错误setwbkDATABAS = Nothing

    Sub DATA_BASE_ARCHIVE_FullArchive()

Dim rngNEWROUND As Excel.Range
Dim arrNEWROUND As Variant
Dim wbkDATABASE As Excel.Workbook
Dim rngDataTarget As Excel.Range
Dim rngDataSource As Excel.Range
Dim varData As Variant
Dim rngArchive As Excel.Range


Application.ScreenUpdating = False

Set rngNEWROUND = ThisWorkbook.Sheets("NEWROUND").Range("A1:N2000")

arrNEWROUND = ThisWorkbook.Sheets("NEWROUND").Range("A1:N2000")

Set wbkDATABASE = Workbooks.Open(filename:="E:\DELEGATION APPLICATION SAMPLE\2-2023\DATABASE.xlsm")

Set rngDataTarget = wbkDATABASE.Sheets("FullArchive").Range("A2001")

Set rngDataTarget = rngDataTarget.Resize(UBound(arrNEWROUND, 1), UBound(arrNEWROUND, 2))

rngDataTarget.Value = arrNEWROUND 

Set rngDataSource = rngDataTarget.Worksheet.Range("A2001")

varData = rngDataSource.Value 
wbkDATABASE.Save
wbkDATABASE.Close

setwbkDATABASE = Nothing '(and Im getting error here)

Set rngArchive = ThisWorkbook.Sheets("ARCHIVE").Range("A1") 'reference range

rngArchive.Value = varData   
   
   
ThisWorkbook.Worksheets("ARCHIVE").Sort.SortFields.Clear
ThisWorkbook.Worksheets("ARCHIVE").Sort.SortFields.ADD Key:=Columns("L:L"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ThisWorkbook.Worksheets("ARCHIVE").Sort.SortFields.ADD Key:=Columns("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ThisWorkbook.Worksheets("ARCHIVE").Sort
      .SetRange Columns("A:P")
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
End With

Application.ScreenUpdating = True

Sheets("FORM").Select

End Sub

我已注释掉您的代码行并将我的代码行放在下面,以便您可以看到如何“翻译”您的代码。您可以进一步缩短代码,但它可能不会变得更容易理解。

Sub DATA_BASE_ARCHIVE_FullArchive()
  
        'declarations
  Dim rngNewRound As Excel.Range    'range object in ThisWorkbook
  Dim arrNewRound As Variant        '2-dim array with content of range
  Dim wbkDatabase As Excel.Workbook 'DATABASE object
  Dim rngDataTarget As Excel.Range  'target range in database
  Dim rngDataSource As Excel.Range  'source range in database
  Dim varData As Variant            'cell content from database
  Dim rngArchive As Excel.Range     'target range on sheet ARCHIVE

  Application.ScreenUpdating = False 'don't forget ... = True at the end
    
  'Windows("ENTRY APPLICATION.xlsm").Activate
  'Sheets("NEWROUND").Select
  'Range("A1:N2000").Select
        'supposing that this VBA code is contained in ENTRY APPLICATIN.xlsm
  Set rngNewRound = ThisWorkbook.Sheets("NEWROUND").Range("A1:N2000") 'reference range
  'Selection.Copy
  arrNewRound = rngNewRound.Value 'save the content of the range in an array
    
  'Workbooks.Open Filename:="\\2-2023\DATABASE-2-2023.xlsm"
  Set wbkDatabase = Workbooks.Open(Filename:="\\2-2023\DATABASE-2-2023.xlsm")
        'is DATABASE.xlsm = DATABASE-2-2023.xlsm? Please clarify!
  'Windows("DATABASE.xlsm").Activate
  'Range("A2001").Select
  Set rngDataTarget = wbkDatabase.Sheets("FullArchive").Range("A2001") 'set top-left corner
        'resize the range so that it matches the size of the array
  Set rngDataTarget = rngDataTarget.Resize(UBound(arrNewRound, 1), UBound(arrNewRound, 2))
  'Sheets("FullArchive").Paste
  rngDataTarget.Value = arrNewRound 'insert array to range
  
  'Cells.Select
  'Range("A2001").Activate
  Set rngDataSource = rngDataTarget.Worksheet.Range("A2001") 'new range in same worksheet
  'Application.CutCopyMode = False
  'Selection.Copy
  varData = rngDataSource.Value     'save range value to single variable
  wbkDatabase.Save                  'save the database
  wbkDatabase.Close                 'close the database
  Set wbkDatabase = Nothing         'release memory
  
  'Windows("ENTRY APPLICATION.xlsm").Activate
  'Sheets("ARCHIVE").Select
  'Range("A1").Select
  Set rngArchive = ThisWorkbook.Sheets("ARCHIVE").Range("A1") 'reference range
  'ActiveSheet.Paste
  'Application.CutCopyMode = False
  rngArchive.Value = varData        'insert single variable to cell A1
  
  'The sorting is probably ok. Please use ThisWorkbook instead of ActiveWorkbook
  ActiveWorkbook.Worksheets("ARCHIVE").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("ARCHIVE").Sort.SortFields.Add Key:=Columns("L:L"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  ActiveWorkbook.Worksheets("ARCHIVE").Sort.SortFields.Add Key:=Columns("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("ARCHIVE").Sort
      .SetRange Columns("A:P")
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  End With
  
  Windows("DATABASE.xlsm").Activate
  ActiveWorkbook.Save
  ActiveWindow.Close
  Application.CutCopyMode = False
  Windows("ENTRY APPLICATION.xlsm").Activate
  
  Application.ScreenUpdating = True 'otherwise you may not see the updated result
  
  Sheets("FORM").Select

End Sub
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

从共享文件夹上的另一个 Excel 工作簿复制并粘贴到同一文件夹 的相关文章

  • 由于直接引用范围而不是通过中间变量而导致 Excel VBA 运行时错误 450

    当我尝试直接引用某个范围内的值时 出现运行时错误 450 但如果我使用中间变量 它就会起作用 我不明白为什么 所以我担心在将来的某个时候我会再次遇到错误而不知道为什么 我尝试过使用 With End With 块 但当我直接引用范围时它仍然
  • 将 Python Selenium 输出写入 Excel

    我编写了一个脚本来从在线网站上抓取产品信息 目标是将这些信息写入 Excel 文件 由于我的Python知识有限 我只知道如何在Powershell中使用Out file导出 但结果是每个产品的信息都打印在不同的行上 我希望每种产品都有一条
  • 在 VBA 中按键对字典进行排序

    我使用 VBA 创建了一个字典CreateObject Scripting Dictionary 将源单词映射到要在某些文本中替换的目标单词 这实际上是为了混淆 不幸的是 当我按照下面的代码进行实际替换时 它将按照源单词添加到字典中的顺序替
  • 我需要代码在两行之间复制并粘贴到另一张表中,并给出任何值?

    例如 我有 50 行数据 第一行有学生的名字 我需要代码将数据从 RAM 复制到 RAMESH 在这之间我有 20 行 我需要代码来复制行并将其粘贴到另一张纸中 它不应该问我名字 默认情况下 它必须采用 RAM 和 RAMESH 名称 好的
  • 使用 VBA 通过简单命令从非连续范围的并集获取值到数组中(无循环)

    我有以下任务 表面上很简单 使用 VBA 将电子表格上多个列的值复制到二维数组中 为了让生活更有趣 这些柱子并不相邻 但它们的长度都相同 显然 可以通过依次循环每个元素来做到这一点 但这看起来非常不优雅 我希望有一个更紧凑的解决方案 但我很
  • 如何使用 Excel Interop 获取筛选行的范围?

    我正在为我的项目使用 Excel Interop 程序集 如果我想使用自动过滤器 那么可以使用 sheet UsedRange AutoFilter 1 SheetNames 1 Microsoft Office Interop Excel
  • 如何在不滚动的情况下截取整个电子邮件正文?

    我正在使用 OL2010 想要制作整个电子邮件的屏幕截图 不仅仅是 屏幕 可以用VBA或者外部程序来完成吗 有一个类似的问题 https stackoverflow com questions 4176340关于如何使用 C 实现这一点 注
  • MS Access 执行 POST Web 请求

    在我的 MS Access 应用程序中 我需要定期向我的网络服务器发送一批信息 我不需要任何花哨的东西 比如 SOAP XML RPC 或任何东西 只需一个简单的 POST 页面请求就足够了 我用谷歌搜索了一下 但找不到任何真正有用的东西
  • VBA XML V6.0 如何让它等待页面加载?

    我一直在努力寻找答案 但似乎找不到任何有用的东西 基本上 我是从一个网站上拉取的 当您在该页面上时 该网站会加载更多项目 我希望我的代码在加载完成后提取最终数据 但不知道如何让 XML httprequest 等待 Edited Sub p
  • 如何在字符串vba中包含引号

    我想存储以下文本 Test1 Monday Test Abcdef 全部在字符串中包含引号 我知道要在字符串中包含引号 我必须包含 之前 但在这里这不是一个很好的解决方案 因为我在文本中有太多这样的解决方案 知道如何一次完成这一切吗 您有两
  • Word通过vba宏删除tabe列出现错误

    我想将excel中的数据复制到word表中 然后从表中删除一些列 我可以将数据复制到表中 但是当我删除列时会出现错误 无法访问此集合中的各个列 因为该表具有混合的单元格宽度 我的代码 Public Tbl1 As Table Sub cal
  • MS Access - 粘贴确认事件后

    当用户将记录直接粘贴到数据表子报表中时 是否可以在显示粘贴确认消息后捕获事件 我需要它能够在审计表中创建新记录时进行记录 通过捕获更新前 更新后和插入事件 我可以轻松创建已添加的记录集合 准备将详细信息插入审核日志 但是在所有这些事件触发后
  • 复制一张工作表上的静态范围,然后根据单元格中的单个值粘贴到另一张工作表中的动态范围

    我对这个问题分为三个部分 我在 Sheet1 A1 中有一个带有周数的单元格 我在 Sheet1 B1 F1 中有一个需要复制的静态范围 然后 我需要将该值粘贴到 Sheet2 中的动态范围中 偏移量为行的周数 这是我正在为我经常使用的工作
  • Outlook 无法识别一个或多个姓名

    我有以下 vba 代码 它读取邮箱并向任何发送无效代码作为邮箱回复的用户发送回复 但有时会收到运行时错误 Outlook 无法识别一个或多个名称 我的问题是 创建新的 MAPI 配置文件是否可以解决该问题 或者我是否需要添加一个代码来解析地
  • 使用 Apache POI Excel 写入特定单元格位置

    如果我有一个未排序的参数 x y z 列表 是否有一种简单的方法将它们写入使用 POI 创建的 Excel 文档中的特定单元格 就好像前两个参数是 X 和Y 坐标 例如 我有如下行 10 4 100 是否可以在第 10 行第 4 列的单元格
  • 如何使用VBA根据条件删除Excel中的行?

    我目前正在构建一个宏来格式化数据表并删除不适用的数据行 具体来说 我希望删除列 L ABC 的行以及删除列 AA DEF 的行 到目前为止 我已经实现了第一个目标 但还没有实现第二个目标 现有代码是 Dim LastRow As Integ
  • 将ADODB二进制流转换为字符串vba

    我有以下问题 我有一个存储在服务器上的 CSV 文件 但它有 3 个字符作为分隔符 我想从 URL 加载数据并使用 作为分隔符将数据填充到 Excel 页面的列中 到目前为止 我找到了使用 ADODB 记录集从网站加载文件的代码 但我无法进
  • 读取R中打开的Excel文件

    有没有办法将打开的Excel文件读入R 当Excel中打开一个excel文件时 Excel会对文件加锁 比如R中的read方法无法访问该文件 你能绕过这个锁吗 Thanks 编辑 这发生在带有原始 Excel 的 Windows 下 发生错
  • Excels COUNTIFS 函数中的数组作为条件,混合 AND 和 OR [重复]

    这个问题在这里已经有答案了 我已经在谷歌上搜索了一段时间 但似乎无法让它发挥作用 我使用 Excel 2010 希望混合使用 AND 和 OR 运算符来计算行数 我想做的是这样的 COUNTIFS A A string1 B B strin
  • 将匹配的行复制到另一张纸中

    我有两张表 sheet1 和sheet 2 我正在查看工作表 1 的 T 列 如果工作表 2 中 T 包含 1 则粘贴完整行 该代码运行良好 但它将sheet2 中的结果粘贴到sheet1 的同一行中 这会导致行之间出现空白 任何人都可以建

随机推荐

  • 如何在 Android Canvas 上使用大量图元绘制游戏

    我在游戏的每一帧中画了很多线条矩形 这是老式手持电子游戏的娱乐 那些具有用于主游戏的原始点阵显示和用于文本或某些图像的自定义图像的内容 我在虚拟点阵屏幕上有 20x20 大 像素 我还在屏幕上绘制了一些 7 段显示和其他一些东西 根据Tra
  • 更改“corrplot()”中有意义的 pch 符号的位置?

    下面的脚本生成一个图 其中表示重要性的 pch 符号与 r 值重叠 如何移动 pch 符号的位置以使它们不与这些值重叠 library corrplot ex mat lt matrix c 1 00 0 46 0 75 1 00 0 46
  • Fluent NHibernate BinaryBlobType

    今天我正在研究 MySQL 数据库 我不知道如何将 Byte 映射到 BLOB 列 我的表看起来是这样的 CREATE TABLE images Id INT NOT NULL AUTO INCREMENT imgText VARCHAR
  • 函数数组的替代方案?

    我正在编写一个应用程序 php 它需要一个很长的列表相似但不同的功能 由一组按键调用 functions do this gt function does this do that gt function does that etc 我选择
  • 使用 Java API 制作 ePub

    我对 ePub 格式比较陌生 但如果我理解得很好 以编程方式从 XHTML 或 PDF 内容开始制作 ePub 可能意味着 选择 HTML 或 XHTML 内容并使用 XHTML 验证器验证它们 或使用 Tydy 清理它们 选择要插入 eP
  • 在 jQuery datepicker buttonImage 属性中引用 Bootstrap 图标?

    我应该为 jQuery 日期选择器使用什么值buttonImage属性 我想将 Bootstrap 日历图标与 jQuery 日期选择器一起使用 当像这样引用时 我可以在 html 页面中使用图标图像 i class icon calend
  • Identity 3 SignInManager.PasswordSignInAsync() 不返回任何结果

    我正在使用 Identity 3 0 创建 Web 应用程序 但 SignInManager PasswordSignInAsync 方法有问题 我像在文档中一样使用它 但它不会返回任何内容 应用程序代码就停在那里 这是我的控制器代码 pu
  • pygame.display.update 更新整个屏幕

    我正在创建一个分屏多人游戏 我首先在左侧绘制第一个玩家 宇宙飞船 燃烧弹 背景中的星星 以半速滚动 最后是背景 然后为第一个玩家更新屏幕的第一部分 然后我在屏幕的另一部分为第二个玩家做同样的事情 但大多数图像在两个半屏幕上重叠 见下图 所以
  • 协助创建名为“(FundingResource(Balance))”的子过程 Visual Basic

    我正在开发一个由三个事件过程组成的程序 换句话说 三个不同的任务按钮 选择媒体和估计资金 添加机构 和 生成报告 当点击 选择媒体和预估资金 按钮时 会弹出输入框并要求用户输入余额 该余额将通过 余额 余额 1 利率 的公式计算 用户输入不
  • Python 的“open()”针对“文件未找到”抛出不同的错误 - 如何处理这两个异常?

    我有一个脚本 提示用户输入文件名 要打开的文件的文件名 如果当前目录中不存在该文件 则会再次提示用户 这是简短的版本 file input Type filename try fileContent open filename r exce
  • 为什么 Ruby 2.0 优化后 `send` 会失败?

    为什么这不起作用 module StringRefinement refine String do def bar length end end end using StringRefinement abcdefghijklmnopqrst
  • 从 SamlResponse 读取继电器状态

    我们将 SustainSys Saml2 与 IdentityServer4 结合使用 我们在这个问题中概述了以下工作流程收到 OneLogin 的 SAML 响应后如何维护 returnurl https stackoverflow co
  • 带下拉列表的循环引用

    MS 中可以吗 Excel 或 VBA 具有带下拉列表的循环引用 这就是我想要的 我想在两张表 表 1 表 2 上生成一个下拉列表 其中显示 完整 或 不完整 如果我将工作表 1 从完整更改为不完整 我希望工作表 2 说同样的事情 但我也希
  • 在 C++ 中迭代链表比在 Go 中慢

    编辑 收到一些反馈后 我创建了一个新的例子 https stackoverflow com questions 50282452 iterating over linked list in c is slower than in go wi
  • 如何从投影类型推断正确的类型参数?

    我在让 Scala 从类型投影推断正确的类型时遇到一些麻烦 考虑以下 trait Foo type X trait Bar extends Foo type X String def baz F lt Foo x F X Unit 然后以下
  • ASP.NET MVC Html.RadioButton 异常

    我的页面上有一个简单的单选按钮列表 我在视图中使用以下内容进行渲染
  • 连接两列值pandas

    我有一个数据框数据 Cluster OsId BrowserId PageId VolumePred ConversionPred 255 7 11 17 1149582 4 0 607 18 99 16 917224 8 0 22 0 1
  • Android:ListView圆角被列表项隐藏

    我有这个列表视图元素
  • QSettings():如何保存到当前工作目录

    对于可以直接从闪存 笔 USB 跳转 拇指驱动器运行的应用程序 为了从一台机器移动到另一台机器的可移植性 将用户设置存储在记忆棒上与应用程序相同的目录中是有意义的 程序正在运行 而不是 Windows Mac Linux 用户或每台机器的系
  • 从共享文件夹上的另一个 Excel 工作簿复制并粘贴到同一文件夹

    请告诉我以下问题 我已经为此工作了 3 个月 但我无法理解它 我必须解释整个项目 以便您能够理解我希望我的代码做什么 我创建了一个用于数据输入的用户表单 它将由 3 个用户同时使用 PC 上的每个用户都有相同的 Excel 工作簿 ENTR