Question

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

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

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

Answer 1

坏消息是，根据您上面的评论，在您编写此程序之前，您需要先做适量的工作。好消息是程序本身会相对简单，你在过程中获得的知识将证明是非常有用的（如果你喜欢学习它也应该很有趣）。

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

告诉您的程序源文件的存储位置（可能它们都存储在一个目录中;这将使它更容易）
一次打开一个文档
复制并粘贴您感兴趣的工作表（可以在一个声明中完成）
关闭文档
重复2-4
完成后，退出程序

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

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

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

1 个答案: