Hi everyone,
I'd really appreciate if someone helped me with this problem. Admittedly, I'm very new to all this so please go easy on me.
I have a code that consolidates data from a large number of workbooks to a single master worksheet. I'm targeting same cells from different workbooks (for example A5 from all workbooks and pasting them into my worksheet as a list under A1, and A13 under B1, etc). But when it completes the A1 column, it goes to the next column AND the next row. (e.g. when A1 to A11 is finished, it starts pasting to B12 in the destination, rather than starting from B1).
Here is the code:
I'd really appreciate if someone helped me with this problem. Admittedly, I'm very new to all this so please go easy on me.
I have a code that consolidates data from a large number of workbooks to a single master worksheet. I'm targeting same cells from different workbooks (for example A5 from all workbooks and pasting them into my worksheet as a list under A1, and A13 under B1, etc). But when it completes the A1 column, it goes to the next column AND the next row. (e.g. when A1 to A11 is finished, it starts pasting to B12 in the destination, rather than starting from B1).
Here is the code:
Code:
Sub MergeFiles()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 1 'Row to start on in the sheets you are copying from
ThisWB = ActiveWorkbook.Name
path = "C:\batch"
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.csv", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range("A5:E5")
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Wkb.Close False
End If
Filename = Dir()
Loop
Range("A1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub