Loop files onto master sheet but data keeps overwr

2019-09-12 04:10发布

I'm trying to use vba in excel to auto loop a set of files to paste their data into a master spreadsheet. I think I have the code right, almost-- but there is one big issue. The files loop and data copies, but every time another set of data is pasted, it overwrites the previously pasted data. I need the data from all the looped files to populate onto the master one after another, not one replacing the other. I've pasted the code I'm using below. Thanks in advance for your help!

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Dim Filepath As String
    Filepath = "V:\Purchasing\Grocery\Promos-DF and Grocery Assistants\HHL\HHL 2016\10-October 2016 HHL\Initial\New Folder\"
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
        If MyFile = "zOctober Master.xlsm" Then
            Exit Sub
        End If

        Workbooks.Open (Filepath & MyFile)
        Rows("21:100").Copy
        ActiveWorkbook.Close

        erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Row
        ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 1))


        MyFile = Dir

    Loop

End Sub

4条回答
Fickle 薄情
2楼-- · 2019-09-12 04:32

Use the cell you want as the top-left corner of your destination.

  erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Row
  Sheet1.Paste Destination:=Sheet1.Cells(erow, 1)

Either use the Worksheet .Name property or the Worksheet .CodeName property. Mixing and matching can only lead to trouble if they become 'unsynced'. In other words, if you ask for the next row to paste into from the worksheet codename Sheet1, then use the worksheet codename Sheet1 to identify the destination of your paste. There is nothing in your code that guarantees that the ActiveSheet property is the worksheet identified by Sheet1 codename, nor is there any guarantee that either is the worksheet with a name tab that says Sheet1.

查看更多
Summer. ? 凉城
3楼-- · 2019-09-12 04:46

There is no need to Select or Active Ranges. It is best to work with the Range directly.

Open External WorkBook and then Copy a Range to the Original Workbook.

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Dim xlMyWorkBook As Workbook
    Dim Filepath As String
    Filepath = "V:\Purchasing\Grocery\Promos-DF and Grocery Assistants\HHL\HHL 2016\10-October 2016 HHL\Initial\New Folder\"
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
        If MyFile = "zOctober Master.xlsm" Then
            Exit Sub
        End If
     
        Set xlMyWorkBook = Workbooks.Open(Filepath & MyFile)
        
        xlMyWorkBook.ActiveSheet.Rows("21:100").Copy Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
        
        xlMyWorkBook.Close
        MyFile = Dir
    Loop

End Sub

Updated:
Changed

xlMyWorkBook.Rows

To

xlMyWorkBook.ActiveSheet.Rows

Use this for Debugging

Sub LoopThroughDirectory()
    Const bDebugging As Boolean = True
    Dim MyFile As String
    Dim erow
    Dim wbSource As Workbook, wbTarget As Range
    Dim Filepath As String
    Dim lastRow As Long
    Filepath = "V:\Purchasing\Grocery\Promos-DF and Grocery Assistants\HHL\HHL 2016\10-October 2016 HHL\Initial\New Folder\"
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
        If MyFile = "zOctober Master.xlsm" Then Exit Sub

        lastRow = Sheet1.Cells(rows.Count, 1).End(xlUp).Row + 2
        Set wbTarget = Sheet1.Cells(lastRow, 1)
        Set wbSource = Application.Workbooks.Open(Filepath & MyFile)

        If bDebugging Then
            wbSource.ActiveSheet.rows("21:100").Select
            MsgBox "This is the Source Range", vbInformation
            Sheet1.Activate
            MsgBox "This is the Destination Range", vbInformation
        Else
            wbSource.ActiveSheet.rows("21:100").Copy wbTarget
        End If

        wbSource.Close False
        MyFile = Dir
    Loop

End Sub

查看更多
爷、活的狠高调
4楼-- · 2019-09-12 04:48

since your quite "fixed" rangetocopy address (always Rows("21:100")) if you could also fix the maximum columns number (say 100) you can avoid the burden and hassle of opening/closing workbooks and just go like follows:

Option Explicit

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim Filepath As String
    Dim iFile As Long

    Filepath = "V:\Purchasing\Grocery\Promos-DF and Grocery Assistants\HHL\HHL 2016\10-October 2016 HHL\Initial\New Folder\"
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
        If MyFile <> "zOctober Master.xlsm" Then
            iFile = iFile + 1
            With ActiveSheet.Range("A1:A80").Resize(,100).Offset((iFile - 1) * 80)
                .Formula = "='" & Filepath & "[" & MyFile & "]Sheet1'!A21"
                .value = .value
            End With
        End If
        MyFile = Dir
    Loop
End Sub

Actually it's possible to act similarly even if you can't assume a "fixed" maximum columns number from the source sheets.

But for starters let's begin like above

查看更多
迷人小祖宗
5楼-- · 2019-09-12 04:55

I believe the issue you are encountering is caused by the End(xlUp) call. The way you have it written (starting from the last occupied row), it will always go back to the first cell, hence the overwritting. If you remove this call (keeping the 2 row offset), your sub should function as desired.

In general, it is best to avoid using End() entirely because its function varies depending upon the cells it encounters (for example, if you call End(xlToLeft) while in a merged cell, it will travel to the first cell in the merged range regardless of whether or not the cells before that are occupied and contiguous)

查看更多
登录 后发表回答