编写一个excel宏来复制（复制）新文档中的页面

Question

我想编写一个宏，它将从不同的 excel 文档中复制列和行，并将它们放入一个文档但在不同的页面上。

我的 C 盘上有一个文件夹，其中包含几个不同的 Excel 文档，每个文档都有不同的页面，我要复制（复制）的唯一页面是一个名为“用户”的页面。我想要做的是从这一页复制所有内容（在不同的文档中）并将其放入另一个 excel 文档中，每个文档都有自己的页面，并且每个页面都以 c 驱动器上原始文档的名称来调用。

希望我已经足够清楚地解释了这一点，是一个能够做我想做的事的宏。目前我只是将这个“用户”页面的所有内容复制并粘贴到一个文档中（这非常耗时）。

Answer 1

坏消息是，根据您上面的 cmets，在您能够编写此程序之前，您还有相当多的工作要做。好消息是程序本身相对简单，而且您在此过程中获得的知识将非常有用（如果您喜欢学习，它应该也很有趣）。

您希望程序完成任务的基本概述是：

1. 告诉你的程序源文件存储在哪里（大概它们都一起存储在一个目录中；这样会容易很多）
2. 每次打开一个文档
3. 复制并粘贴您感兴趣的工作表（这可以在一个语句中完成）
4. 关闭文档
5. 重复 2-4
6. 完成后退出程序

做到这一点的最好方法是将整个事情分成几部分。第一个/顶部的部分看起来像这样：

Sub CopyAllTheUserWorksheets()
    'Get the folder/directory location with your source files:
    Dim MyDirectory As String
    MyDirectory = SelectFolder 
    'SelectFolder is another function you write separately that will open a
    'file dialog box and return the path of the folder you choose. If you
    'cancel the file dialog, it will just return a "\"

    'Now test to make sure a directory was chosen:
    If MyDirectory = "\" Then Exit Sub

    'Create the file name you will loop over to open all the Excel files:
    Dim MyFile As String
    MyFile = Dir(MyDirectory & "*.xlsx")
    'Change .xlsx to .xls if your source files are the old Excel file format

    'Open each file one at a time, perform the actions you want to perform,
    'then close the file. You accomplish this using what is called a Loop.
    'There are a handful of different kinds of Loops. For this task I suggest a
    'Do While loop. Before the loop, we make a Workbook variable in which to
    'store the opened workbook so we can work with it inside of the loop.
    Dim wb As Workbook
    Do While MyFile <> ""
       'Open the Excel workbook:
        Set wb = Workbooks.Open(Filename:=MyDirectory & MyFile)

       'Here you put the task you want to do with the workbook.
       'We'll put that in a separate procedure as well to keep things tidy.
        Call CopyTheUserWorksheetToThisWorkbook(wb)

       'Now that we are done copying the worksheet, close the Excel workbook 
       'without saving any changes
        wb.Close SaveChanges:=False

       'Proceed to the next file name. If there are no more files that match
       '*.xlsx, then myFile will be equal to an empty string, which is "", and
       'the Do While loop with end at that point.
        myFile = Dir
    Loop

End Sub

看看你是否能理解这一点。稍后我会添加更多内容（用于SelectFolder 函数和CopyTheUserWorksheetToThisWorkbook 过程）。

请注意，this link 在制定此答案时非常有帮助，并且可能会帮助您更好地了解正在发生的事情。

编辑：这是上述过程调用的SelectFolder 函数：

Function SelectFolder() As String
    'Make a string variable to hold the folder path
    Dim MyFolder As String
    'Make a FileDialog object for choosing the folder
    Dim MyFolderChooser As FileDialog

    'Make the FileDialog object
    Set MyFolderChooser = Application.FileDialog(msoFileDialogFolderPicker)
    'Give it a title (optional)
    MyFolderChooser.Title = "Select A Target Folder"
    'Disable MultiSelect (you only want one folder selected)
    MyFolderChooser.AllowMultiSelect = False
    'This is a normal dialog box, so it could be Cancelled, or Closed. We 
    'need to tell the procedure what to do if that happens. The statement 
    'below basically says "If the dialog is cancelled,skip everything until
    'NextStep." Without this, you would get an error if you canceled or closed
    'the file dialog.
    If MyFolderChooser.Show <> -1 Then GoTo NextStep
    'Assign the MyFolder variable the value given to the FileDialog object
    MyFolder = MyFolderChooser.SelectedItems(1)
    'The (1) means the first value. Since we turned MultiSelect off, there
    'will be no (2), (3), etc, but VBA isn't smart enough to figure this
    'out on its own so you have to tell it.

NextStep:
    'Now just set the name of the function (SelectFolder) equal to the result
    'you want, and that value will be returned to the procedure that called
    'the function.
    SelectFolder = MyFolder & "\" 
    'If no directory was chosen, the function will return just "\"

End Function