Trying to import data from one excel sheet to another

[lucpian]

Hi All,

I am trying to import data from one Excel sheet to another which is a template, but the problem is that though it dialogs to the folder containing the Excel files, it does not import the data. What might be wrong with my code. Here is the code:

Sub ImportExceldataFile()

Dim sFile As String
Dim lFNum As Long
Dim vaFields As Variant
Dim i As Long
Dim lRow As Long
Dim vaStrip As Variant
Dim FileName As Variant
Dim Sep As String

Application.ScreenUpdating = False
On Error GoTo EndMacro:
lFNum = FreeFile

sFile = Application.GetOpenFilename(FileFilter:="Excel File (*.xls),*.xls")
'If sFile = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
' Exit Sub
'End If
Const sDELIM = "|" 'Set the delimiter

lFNum = FreeFile
'sFile = "C:CaratDelim.txt"
vaStrip = Array(vbLf, vbTab) 'list the text to strip

'Open the file
Open sFile For Input As lFNum

vaFields = GetExcelData(lFNum, vaStrip, sDELIM)
i = LBound(vaFields)


'Loop through the file until the end
Do While Not EOF(lFNum)

vaFields = GetExcelData(lFNum, vaStrip, sDELIM)
lRow = lRow + 1

'Write to the worksheet
For i = 0 To UBound(vaFields)
Sheet1.Cells(lRow, i + 1).Value = vaFields(i)
Next i
Loop


EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close lFNum

End Sub

Private Function GetExcelData(ByVal FileNum As Long, _
ByVal Redundant As Variant, _
ByVal Delimiter As String) As Variant
Dim sInput As String
Dim i As Long

Line Input #FileNum, sInput 'input the current line
'remove the unwanted text
For i = LBound(Redundant) To UBound(Redundant)
sInput = Replace(sInput, Redundant(i), " ")
Next i

'split the text based on the delimeter
GetExcelData = Split(sInput, Delimiter)
End Function

Thanks

Lucpian

[MikeO]

The "Open for Input as" method is generally used for text files. When you try to import excel workbooks with this method, it's going to read in all of the various special characters and symbols that excel uses to characterize all of the objects and properties in the workbook...in addition to the data in the cells. Also, there usually are no line return characters, so after the first Line Input command, you'll be at EOF. That's why your code is jumping to "EndMacro" on the first pass.
You're best bet is to open the workbook and copy the data.

[lucpian]

Hi Mike,

Thanks. Please, can you give me a sample vba code on how to do that.

Thanks, again

Lucpian

[RonMcK]

lucpian,

In the future, please consider enclosing your code in 'code tags'; it will make your code easier to read. Just click the 'vba' icon on the editor bar before you Insert your code into your message.

So, instead of this:

'Loop through the file until the end
Do While Not EOF(lFNum)

vaFields = GetExcelData(lFNum, vaStrip, sDELIM)
lRow = lRow + 1

'Write to the worksheet
For i = 0 To UBound(vaFields)
Sheet1.Cells(lRow, i + 1).Value = vaFields(i)
Next i
Loop


You will have:
[vba] 'Loop through the file until the end
Do While Not EOF(lFNum)

vaFields = GetExcelData(lFNum, vaStrip, sDELIM)
lRow = lRow + 1

'Write to the worksheet
For i = 0 To UBound(vaFields)
Sheet1.Cells(lRow, i + 1).Value = vaFields(i)
Next i
Loop
[/vba]
Thanks,

[MikeO]

[VBA]Sub ImportExceldataFile()
Dim sFile As String
Dim sBook As Workbook
Dim sSheet As Worksheet
Application.ScreenUpdating = False
sFile = Application.GetOpenFilename(FileFilter:="Excel File (*.xls),*.xls")
Set sBook = Workbooks.Open(sFile)
Set sSheet = sBook.Sheets(1)
'Write code to copy data from sSheet here.
'Write code to paste data to template sheet here.

End Sub
[/VBA]

[lucpian]

Hi Mike,

Thanks so much for your help, but I am still having problem. Right now it temporary copies it, but comes up with an error, and suddenly opens up the file you were copying from. I basically used your approach, and only slightly modified the code. Here is the code:

Sub ImportDataintoExcelTemplate()
Dim SourceBook As Workbook, NewBook As Workbook
Dim T As Boolean
Set SourceBook = ThisWorkbook
T = Application.Dialogs(xlDialogOpen).Show("*.xls")
If T = False Then Exit Sub
Set NewBook = ActiveWorkbook
With NewBook.Sheets("Sheet1")
.Range(.Range("A1"), .Cells(65536, "A").End(xlUp)).Copy
End With
With SourceBook.Sheets("Testcase2b")
.Activate
.Range("Y1").Activate
.Paste
End With
Application.CutCopyMode = False
NewBook.Close SaveChanges:=False
End Sub

Indeed, when I try to debug, it hangs on "With SourceBook.Sheets("Testcase2b")". I keep having error 9.

Please, what am I doing wrong or what is wrong with my code? Please, members of this forum help.

Thanks

Lucpian

[MikeO]

I believe that error indicates that there is not a worksheet named "Testcase2b" in ThisWorkbook. The code should work otherwise.

[mdmackillop]

Lucpian
Please remember to use the VBA button to format any code that you post.