Curtisyoung78
New Member
- Joined
- Jun 19, 2017
- Messages
- 25
I have a vba code to get info from multiple workbooks then paste them consecutively in one worksheet. I want the macro to paste to cell A1 everytime i run the macro, after clearing contents of the previous time i ran it of course. But instead it pastes to the last cell used from the last time i ran the macro + 1 row.
I have ran the macro 50 times or so and is now pasting to row 3500. How can i get it to paste to cell A1 everytime i run it? I have pasted the vba code below.
'Description: Combines all files in a folder to a master file.
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 = 2 ' Row to start on in the sheets you are copying from
ThisWB = ActiveWorkbook.Name
path = ("T:\Curtis\Pile Data")
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", 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(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
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
End Sub
I have ran the macro 50 times or so and is now pasting to row 3500. How can i get it to paste to cell A1 everytime i run it? I have pasted the vba code below.
'Description: Combines all files in a folder to a master file.
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 = 2 ' Row to start on in the sheets you are copying from
ThisWB = ActiveWorkbook.Name
path = ("T:\Curtis\Pile Data")
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", 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(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
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
End Sub