Excel 2010 VBA 从多个 Excel 文件复制数据

Question

我已经搜索并搜索了这个并且已经接近但并不完美。就这样吧……

我需要的是一个代码，可以连续处理其他excel工作簿并复制数据。这些文件将被命名为 1、2、3、4 等，最多可达 60 个。我有一些代码可以打开我的所有文件，效果很好。接下来，我需要它进入所有工作簿并复制设置数据并将其返回到我也能够完成的主工作簿。这是我的问题...

1. 我知道必须有一种方法可以一次性编写代码并让它在剩余的文件中运行。 IE。如果第一个文件名为 1.csv，代码可以说在 1.csv 上执行，然后在 1.csv + 1 上表示 2.csv，然后循环输出？似乎它应该能够做到。我不想手动编写相同的代码从 1.csv 一直复制到 60.csv

2. 如果有办法循环它，那么我如何结束 end if 部分。 IE 一周可能有 37 个文件，接下来有 ​​40 个，依此类推。我希望它从文件 1.csv 开始并一直工作，直到它到达最后一个活动文件 37.csv 或 60.csv，然后在没有 38.csv 文件时结束。

这是我的基本记录代码。

   Public Sub testr()
  Dim filenum As Integer
  Dim lastrow As Long

  filenum = 1
  On Error GoTo my_handler

  Do
    Windows(filenum & ".CSV").Activate
    Range("A25").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Range("A1").Select
    lastrow = Worksheets("Data").Cells(1, 1).End(xlDown).Row
    ActiveSheet.Paste
    filenum = filenum + 1
  Loop

my_handler:
  MsgBox "All done."
  Exit Sub
End Sub

任何人都可以给我的任何帮助都会很棒！先谢谢了~

Answer 1

好的，对于您现在拥有的代码，您至少需要编辑为如下所示：

Public Sub testr()
  Dim filenum As Integer
  filenum = 1
  On Error GoTo my_handler

  Do
    Windows(filenum & ".CSV").Activate
    Range("A25").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    filenum = filenum + 1
  Loop

my_handler:
  MsgBox "All done."
  Exit Sub
End Sub

Answer 2

您可以尝试将所有这些包装在一个 DO...LOOP 中。如果您不知道要处理多少个 .csv 文件，只需在没有找到更多文件时放入错误处理程序即可退出。

您可以使用字符串连接来更改文件名：例如，使用名为 filenum 的变量，如果 filenum = 1 那么 filenum & ".csv" 将是 "1.csv"，如果 filenum = 2 那么 filenum & " .csv”将是“2.csv”等等。

例如：

Public Sub testr()
Dim filenum As Integer
filenum = 1
On Error GoTo my_handler
Do
  Windows(filenum & ".CSV").Activate
  'rest of code goes here
filenum = filenum + 1
Loop

my_handler:
  MsgBox "All done."
Exit Sub