Question

我为我的工作设计并创建了一个简单的Excel文件，该文件将分发到整个组织，收件人可以通过从下拉列表中选择或根据需要输入特定详细信息来回答大量问题。由于它将在整个组织中发送，因此将有许多人单独填写报告，因此最终会有大量文件需要发回给我，我必须将所有文件合并到一起一张要分析的主表。

我知道如何插入按钮并将简单的代码链接到移动标签等小动作，但我希望收件人能够填写数据表并点击底部的按钮来获取他们的答案从条目表中填充另一个'主表，我可以在其中简单地分析数据的结果。这意味着我不必追逐任何人向我发送数据，因为一旦点击开发者按钮，它就会自动填充另一张表。

为简化起见，让我们假设有5个问题，问题1在A1到A5，每个下拉答案列表单元格在单元格b1-b5中。在单元格C1中，有一个名为“完成”的开发人员按钮。是否有可能将此excel文件中的数据转移到另一个excel文件，以便问题1出现在单元格a1中，结果答案在单元格a2中等等（有效地翻转，因此可以更容易地将数据透视表应用于结果）点击完成按钮。

非常感谢，

格雷厄姆

Answer 1

更简单的方法是生成一个csv文件，其中包含用户名/标识号作为文件名的一部分以及相关的行信息。保存在文件夹中的所有结果.csv文件然后可以使用VBA /宏导入到另一个主Excel中。

这将使整个过程自动化。

所以说Cell A6可以用来接收用户名/ id等，它可以作为文件名，也可以作为csv数据的一部分。

希望这有帮助。

Answer 2

我想你想这样做。

Sub Copy_Every_Sheet_To_New_Workbook()
'Working in 97-2013
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim sh As Worksheet
    Dim DateString As String
    Dim FolderName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    'Copy every sheet from the workbook with this macro
    Set Sourcewb = ThisWorkbook

    'Create new folder to save the new files in
    DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
    FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString
    MkDir FolderName

    'Copy every visible sheet to a new workbook
    For Each sh In Sourcewb.Worksheets

        'If the sheet is visible then copy it to a new workbook
        If sh.Visible = -1 Then
            sh.Copy

            'Set Destwb to the new workbook
            Set Destwb = ActiveWorkbook

            'Determine the Excel version and file extension/format
            With Destwb
                If Val(Application.Version) < 12 Then
                    'You use Excel 97-2003
                    FileExtStr = ".xls": FileFormatNum = -4143
                Else
                    'You use Excel 2007-2013
                    If Sourcewb.Name = .Name Then
                        MsgBox "Your answer is NO in the security dialog"
                        GoTo GoToNextSheet
                    Else
                        Select Case Sourcewb.FileFormat
                        Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                        Case 52:
                            If .HasVBProject Then
                                FileExtStr = ".xlsm": FileFormatNum = 52
                            Else
                                FileExtStr = ".xlsx": FileFormatNum = 51
                            End If
                        Case 56: FileExtStr = ".xls": FileFormatNum = 56
                        Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                        End Select
                    End If
                End If
            End With

            'Change all cells in the worksheet to values if you want
            If Destwb.Sheets(1).ProtectContents = False Then
                With Destwb.Sheets(1).UsedRange
                    .Cells.Copy
                    .Cells.PasteSpecial xlPasteValues
                    .Cells(1).Select
                End With
                Application.CutCopyMode = False
            End If


            'Save the new workbook and close it
            With Destwb
                .SaveAs FolderName _
                      & "\" & Destwb.Sheets(1).Name & FileExtStr, _
                        FileFormat:=FileFormatNum
                .Close False
            End With

        End If
GoToNextSheet:
    Next sh

    MsgBox "You can find the files in " & FolderName

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

有关所有详细信息，请参阅此链接。

http://www.rondebruin.nl/win/s3/win007.htm

将数据从分布式Q / A excel文件移动到单独的主文件中

2 个答案: