Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
799 views
in Technique[技术] by (71.8m points)

excel - Copying worksheets from multiple workbooks into current workbook

Copying worksheets from multiple workbooks into current workbook

Hi I was wondering if anybody if you guys could help me out?

Im trying to copy multiple workbooks and just save it into only one worksheet. I have 2000 diffrent workbooks with the diffrent amount of rows, The ammount of cells is the same and it dosent change and they are all at the first sheet in every workbook.

Im new with this kind of stuff so i'm thankfull for all help u can offer, I cant make it work. I'm using excel 2010

This is what I got atm:

Sub LoopThroughDirectory()
    Dim MyFile As String 
    Dim erow 
    Dim Filepath As String 

    Filepath = “C:est” 
    MyFile = Dir("test") 

    Do While Len(MyFile) > 0 
        If MyFile = "master.xlsm" Then
            Exit Sub 
        End If
        Range(Range("a1"), ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Name = "PivotData" 
        Workbooks.Open (Filepath & MyFile)
        Range("A2:AD20").Copy 
        ActiveWorkbook.Close 
        erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 1))
        MyFile = Dir 
    Loop End
Sub 
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

I've re-written your code by applying what I posted in the comment.
Try this out: (I stick with your logic using the DIR function)

Sub test()

    Dim MyFile As String, MyFiles As String, FilePath As String
    Dim erow As Long
    '~~> Put additional variable declaration
    Dim wbMaster As Workbook, wbTemp As Workbook
    Dim wsMaster As Worksheet, wsTemp As Worksheet

    FilePath = "C:est"
    MyFiles = "C:est*.xlsx"
    MyFile = Dir(MyFiles)

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    '~~> Set your declared variables
    Set wbMaster = ThisWorkbook 'if you want to consolidate files in this workbook
    Set wsMaster = wbMaster.Sheets("Sheet1") 'replace Sheet1 to suit

    Do While Len(MyFile) > 0
        'Debug.Print MyFile
        If MyFile <> "master.xlsm" Then
            '~~> Open the file and at the same time, set your variable
            Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True)
            Set wsTemp = wbTemp.Sheets(1) 'I used index, you said there is only 1 sheet
            '~~> Now directly work on your object
            With wsMaster
                erow = .Range("A" & .Rows.Count).End(xlUp).Row 'get the last row
                '~~> Copy from the file you opened
                wsTemp.Range("A2:AD20").Copy 'you said this is fixed as well
                '~~> Paste on your master sheet
                .Range("A" & erow).Offset(1, 0).PasteSpecial xlPasteValues
            End With
            '~~> Close the opened file
            wbTemp.Close False 'set to false, because we opened it as read-only
            Set wsTemp = Nothing
            Set wbTemp = Nothing
        End If
        '~~> Load the new file
        MyFile = Dir
    Loop

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

End Sub

I've commented the code to help you modify it to suit your needs.
I you got stuck again, then just go back here and clearly state your problem.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...