Need help tweaking VBA

[vmpage]

Hello.

I have a macro that loops through files in a folder and the data is pasted to a summary sheet (Copy Paste Values).

The problem I am having is that it isn't getting everything! Each file that is copied has up to 10 lines of info, but for some reason the first and second files only have 9 of the 10 lines pasted, and the third file is pasted twice, the first time skipping line 10 the second time showing all 10 lines!

I haven't had to mess with any of this in a while and I'm having trouble figuring out what I'm doing wrong!

Below is the code I'm using:

Sub MergeAllWorkbooks()
Dim CopyPasteValues As Worksheet
Dim FolderPath As String
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range

' Set copypastevalues to activeworkbook/activesheet where the macro runs
Set CopyPasteValues = ActiveWorkbook.ActiveSheet

' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\Vanessa.Page\Desktop\Daily POD Updates"

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xlsx")

' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)


'loop through all Sheets in WorkBk
For Each sh In WorkBk.Worksheets

' Set the source range to be A2 through B11.
Set SourceRange = Worksheets(1).Range("A2:B11")

' Set the destination range to start at A1 and
' be the same size as the source range.
Set DestRange = CopyPasteValues.Range("A" & CopyPasteValues.Range("A" & Rows.Count).End(xlUp).Row + 0)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)

' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value

Next sh

' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False

' Use Dir to get the next file name.
FileName = Dir()
Loop

' Call AutoFit on the destination sheet so that all
' data is readable.
ActiveSheet.Columns.AutoFit
End Sub

Any help is greatly appreciated! Thank you!

 

[nikio8]

Hi Hope it helps, I am a bit tired, did not test the macro,


Don't forget to count rows in the correct sheet
DestRow = CopyPasteValues.Cells(CopyPasteValues.Rows.Count, "A").End(xlUp).Row + 1

FileName = Dir(FolderPath & "" & "*.xlsx") ???

Sub MergeAllWorkbooks()    Dim CopyPasteValues As Worksheet
    Dim FolderPath As String
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim DestRow As Long
    
    ' Set copypastevalues to activeworkbook/activesheet where the macro runs
    Set CopyPasteValues = ActiveWorkbook.ActiveSheet
    
    ' Modify this folder path to point to the files you want to use.
    FolderPath = "C:\Users\Vanessa.Page\Desktop\Daily POD Updates"
    
    ' Call Dir the first time, pointing it to all Excel files in the folder path.
    FileName = Dir(FolderPath & "\" & "*.xlsx")
    
    ' Loop until Dir returns an empty string.
    Do Until FileName = ""
        ' Open a workbook in the folder
        Set WorkBk = Workbooks.Open(FileName:=FolderPath & FileName, ReadOnly:=True)
        
        
        'loop through all Sheets in WorkBk
        For Each sh In WorkBk.Worksheets
        
            ' Set the source range to be A2 through B11.
            DestRow = CopyPasteValues.Cells(CopyPasteValues.Rows.Count, "A").End(xlUp).Row + 1
            sh.Range("A2:B11").Copy Destination:=CopyPasteValues.Range("A" & DestRow)
            
                        
        Next sh
            
            ' Close the source workbook without saving changes.
            WorkBk.Close savechanges:=False
        
        ' Use Dir to get the next file name.
        FileName = Dir()
    Loop
    
    ' Call AutoFit on the destination sheet so that all
    ' data is readable.
    ActiveSheet.Columns.AutoFit
End Sub