PDA

View Full Version : VBA Code Assistance



Dmo15
03-01-2017, 10:02 AM
I am trying to copy cells from an unopened file into a new file. I am able to do that - but when i run the program a second time the code overwrites the data imported the first time. Below is the code i am using for the first one. What do i need to change in the second file?

'credit for this technique goes to John Walkenback


Sub GetDataDemo()

Dim FilePath$, Row&, Column&, Address$

'change constants & FilePath below to suit
'***************************************
Const FileName$ = "OnlineCourses.xlsx"
Const SheetName$ = "Sheet1"
Const NumRows& = 14
Const NumColumns& = 22
FilePath = ActiveWorkbook.Path & "\"
'***************************************

DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
For Row = 1 To NumRows
For Column = 1 To NumColumns
Address = Cells(Row, Column).Address
Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Columns.AutoFit
Next Column
Next Row
ActiveWindow.DisplayZeros = False
End Sub


Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("T1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function

Dmo15
03-01-2017, 11:33 AM
I am wanting to run the program to gather information from 6 different spreadsheets and combining the data into one.

SamT
03-01-2017, 03:59 PM
Declare NextRow

Dim NextRow as Long

INsert this LastRow line where indicate

DoEvents
Application.ScreenUpdating = False

NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

If Dir(FilePath & FileName) = Empty Then

Then Change the For Row = 1 To Line to

For Row = NextRow to NumRows + NextRow

Whoops! My bad. you said
What do i need to change in the second file?
In answer to that... Nothing. You need to change the Excel 4 Macro "Data."