EXCEL合并

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

我有三张表要进行合并成一张表，怎么弄？
比如说：三张表是1班、2班、3班成绩表字段全是姓名、性别、成绩1、成绩2..
这样怎么合并（除了复制黏贴）

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏0 回帖

关键词：EXCEL exce xcel cel 复制黏贴 EXCEL

粘贴复制搞定不就行了

Sub RunOnAllXLSFiles()

' This macro copies the data inputs from into a separate workbook. It runs through all files in a specified folder


Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

    With Application.FileSearch.NewSearch
   
         
         'Change path if necessary
        .LookIn = "D:\User Data\My Documents\"
        .FileType = msoFileTypeExcelWorkbooks
        
            If .Execute > 0 Then 'check if there are Workbooks in folder
                For lCount = 1 To .FoundFiles.Count 'Loop through all.
                 'Open Workbook x and Set a Workbook variable to it
                 Set wbResults = Workbooks.Open(.FoundFiles(lCount))
                                 
                 'Copy the relevant sections

                    Sheets("Storage").Select
                  
                    'Columns("B:B").Select
                    Range("B1:B255").Select
                    Selection.Copy
                    
                    wbCodeBook.Activate
                    Sheets("Results").Select
                                        Rows(lCount + 1).Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=True
                    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                        SkipBlanks:=False, Transpose:=True
                              
                 wbResults.Close SaveChanges:=True
                 
                 Application.StatusBar = "File " & lCount & " of " & .FoundFiles.Count & " files copied."
                 
                 Next lCount
            End If
    End With
   
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True

End Sub

Use SAS to merge the data.

多个文件表合到一个文件表的多个SHEET中：
               Dim FilesToOpen, ft
        Dim x As Integer

        Application.ScreenUpdating = False
        On Error GoTo errhandler

        FilesToOpen = Application.GetOpenFilename _
        (FileFilter:="Micrsofe Excel文件(*.xls), *.xls", _
        MultiSelect:=True, Title:="要合并的文件")
        
        If TypeName(FilesToOpen) = "boolean" Then
        MsgBox "没有选定文件"
        'GoTo errhandler
        End If
        x = 1
        While x <= UBound(FilesToOpen)
        Set wk = Workbooks.Open(Filename:=FilesToOpen(x))
        wk.Sheets().Move after:=ThisWorkbook.Sheets _
        (ThisWorkbook.Sheets.Count)
        x = x + 1
        Wend

        MsgBox "合并成功完成！"

errhandler:
        'MsgBox Err.Description
        'Resume errhandler