![]() |
Is there a better method to achieve this?
Hi James
Thanks for response Unfortunately, I can't manage to make your suggested code work. It seems like it should, and breaking at various points and examining variables, I am surprised to end up with only an empty target workbook. Although all the variables show correct data, I just end up with blank ranges in the target workbook - plus, I can't figure out why either. Sorry for not being able to make it work, as your code fits precisely with what I had hoped for - a more logical and concise way of doing it. regards, -- Les Hay, Livingston. Scotland "Jim Becker" wrote in message ... Here's an alternative, untested: Sub TransferFileData(fn As String) Dim Source As Workbook, Target As Workbook Dim i As Integer, tmpRange As Variant '(String) Unload frmFileGet frmReplaceData.Show vbModeless DoEvents Set Target = ActiveWorkbook Set Source = Workbooks.Open(FileName:=fn) For i = 2 To Worksheets.Count - 2 For Each tmpRange In Array("C9:D38", "F9:G38", _ "J9:V38", "X9:Y38", "AA9:AA38") Target.Worksheets(i).Range(tmpRange) = _ Source.Worksheets(i).Range(tmpRange) Next tmpRange Next i Source.Close SaveChanges:=False Unload frmReplaceData End Sub -- Hope this helps, James dot Becker at NCR dot com ~ ~ ~ :wq! "Les" wrote in message ... Hi I have created a sub routine in my workbook with the intention of allowing the replacing of current data from a similar workbook (same structure). Although this sub does work, and as far as I can tell so far, without any problem, I feel it is perhaps a little cumbersome. I have searched through the help files to try to find some sort of statements better equipped to achieve this but can't find anything. Is there a more efficient method to do this? Is it best to open the source workbook and copy? ============================================ Sub TransferFileData(fn As String) Dim currentfilename As String, newfilename As String Dim i As Integer Unload frmFileGet frmReplaceData.Show vbModeless DoEvents currentfilename = ActiveWorkbook.Name Workbooks.Open fn newfilename = ActiveWorkbook.Name Windows(currentfilename).Activate For i = 2 To Worksheets.Count - 2 With Workbooks(currentfilename).Worksheets(i) .Range("c9:d38").Value = Workbooks(newfilename).Worksheets(i).Range("c9:d38 ").Value .Range("f9:g38").Value = Workbooks(newfilename).Worksheets(i).Range("f9:g38 ").Value .Range("j9:v38").Value = Workbooks(newfilename).Worksheets(i).Range("j9:v38 ").Value .Range("x9:y38").Value = Workbooks(newfilename).Worksheets(i).Range("x9:y38 ").Value .Range("aa9:aa38").Value = Workbooks(newfilename).Worksheets(i).Range("aa9:aa 38").Value End With Next i Workbooks(newfilename).Close SaveChanges:=False Unload frmReplaceData End Sub ============================================ regards, -- Les Hay, Livingston. Scotland |
Is there a better method to achieve this?
Hi James
Further to last post, I altered my own existing code to use your inner loop method of an array of ranges and by timing the complete data transfer section found it was reduced from 9.23 secs to 2.3 secs. So thanks once again, I feel tour contribution was valuable and I continue to learn by the help I receive in this newsgroup. -- Les Hay, Livingston. Scotland "Les" wrote in message ... Hi James Thanks for response Unfortunately, I can't manage to make your suggested code work. It seems like it should, and breaking at various points and examining variables, I am surprised to end up with only an empty target workbook. Although all the variables show correct data, I just end up with blank ranges in the target workbook - plus, I can't figure out why either. Sorry for not being able to make it work, as your code fits precisely with what I had hoped for - a more logical and concise way of doing it. regards, -- Les Hay, Livingston. Scotland "Jim Becker" wrote in message ... Here's an alternative, untested: Sub TransferFileData(fn As String) Dim Source As Workbook, Target As Workbook Dim i As Integer, tmpRange As Variant '(String) Unload frmFileGet frmReplaceData.Show vbModeless DoEvents Set Target = ActiveWorkbook Set Source = Workbooks.Open(FileName:=fn) For i = 2 To Worksheets.Count - 2 For Each tmpRange In Array("C9:D38", "F9:G38", _ "J9:V38", "X9:Y38", "AA9:AA38") Target.Worksheets(i).Range(tmpRange) = _ Source.Worksheets(i).Range(tmpRange) Next tmpRange Next i Source.Close SaveChanges:=False Unload frmReplaceData End Sub -- Hope this helps, James dot Becker at NCR dot com ~ ~ ~ :wq! "Les" wrote in message ... Hi I have created a sub routine in my workbook with the intention of allowing the replacing of current data from a similar workbook (same structure). Although this sub does work, and as far as I can tell so far, without any problem, I feel it is perhaps a little cumbersome. I have searched through the help files to try to find some sort of statements better equipped to achieve this but can't find anything. Is there a more efficient method to do this? Is it best to open the source workbook and copy? ============================================ Sub TransferFileData(fn As String) Dim currentfilename As String, newfilename As String Dim i As Integer Unload frmFileGet frmReplaceData.Show vbModeless DoEvents currentfilename = ActiveWorkbook.Name Workbooks.Open fn newfilename = ActiveWorkbook.Name Windows(currentfilename).Activate For i = 2 To Worksheets.Count - 2 With Workbooks(currentfilename).Worksheets(i) .Range("c9:d38").Value = Workbooks(newfilename).Worksheets(i).Range("c9:d38 ").Value .Range("f9:g38").Value = Workbooks(newfilename).Worksheets(i).Range("f9:g38 ").Value .Range("j9:v38").Value = Workbooks(newfilename).Worksheets(i).Range("j9:v38 ").Value .Range("x9:y38").Value = Workbooks(newfilename).Worksheets(i).Range("x9:y38 ").Value .Range("aa9:aa38").Value = Workbooks(newfilename).Worksheets(i).Range("aa9:aa 38").Value End With Next i Workbooks(newfilename).Close SaveChanges:=False Unload frmReplaceData End Sub ============================================ regards, -- Les Hay, Livingston. Scotland |
All times are GMT +1. The time now is 03:32 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com