Dear All,
I want to copy the data from sheet 4 named 'Unique MSISDNs' of all the workbooks in the location. Data to be copied is from A1 to H8. I am facing a problem that data overwrites previous one, data from only last file appears. I am using the below code, please can anyone help me in this.
I want to copy the data from sheet 4 named 'Unique MSISDNs' of all the workbooks in the location. Data to be copied is from A1 to H8. I am facing a problem that data overwrites previous one, data from only last file appears. I am using the below code, please can anyone help me in this.
Private Const sPath As String = "C:\Users\naveed\Downloads\Buzzme-Reports-2" 'CHANGE THIS TO YOUR DIRECTORY PATH
Sub LoopThroughFiles()
Dim sFile As String 'File Name
Dim sExt As String 'File extension you wish to open
sExt = "xlsx" 'Change this if extension is different
'loop through each file name and open it if the extension is correct
sFile = Dir(sPath)
Do Until sFile = ""
If Right(sFile, 4) = sExt Then GetInfo sFile
sFile = Dir
Loop
End Sub
Private Sub GetInfo(sFile As String)
Dim wbFrom As Workbook 'workbook to copy the data from
Dim iRow As Integer 'row number of next empty row
On Error GoTo errHandle
Application.EnableEvents = False
Application.ScreenUpdating = False
Set wbFrom = Workbooks.Open(sPath & sFile)
wbFrom.Sheets("Unique MSISDNs").Range("A1:H8").Copy 'Copy A1:H8
iRow = Me.Range("A" & Rows.Count).End(xlUp).Row + 1 'Get an empty row in this workbook
Me.Range("A1:H8" & iRow).PasteSpecial xlPasteAll 'past copied cells
wbFrom.Close (False)
Application.EnableEvents = True
Application.ScreenUpdating = True
Set wbFrom = Nothing
Exit Sub
errHandle:
MsgBox Err.Description
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub