none
Fishing for answers? Create a sheet that contains, "From WB, Sheet and Cell locations" and "To WB, Sheet and Cell locations" and use VBA to execute the copy and paste value RRS feed

  • Question

  • Board members, you're so appreiacted! Probably the biggest challenge is to try and explain the end goal. Work with me here, I'm a nube... What I have is a legacy spreadsheet, with reluctance to correct it. I have created a spreadsheet that captures the same detail in a consise manner in a fraction of the time. However the deliverable needs to be the legacy format. I beleive there has to be a better way that hard code my VBA to brute force copy workbook A, sheet1 C5, to workbook B, sheet4 d44. Can I use a blank sheet on my form and create a map with "From" Sheet Name, Cell Name  "To" Sheet Name, Cell Name on the legacy form.  Seems easier to change and map out? Or is there a better approach all the way around that I am not aware of. Always eager to learn more, but I need to understand it first :) Please Advise

    Thank you.




    Friday, January 31, 2014 3:14 AM

All replies

  • You could hard code your VBA to copy specific cells of specific sheets of any workbook. Let's say that your legacy workbook is named "Legacy.xls" and that you want to be able to choose the .xlsx workbook to grab data from. Change the Path to Legacy.xls, and use code like

    Sub TestMacro()
    Dim rngC As Range
    Dim wbLegacy As Workbook
    Dim wbData As Workbook

    Set wbData = Workbooks.Open(Application.GetOpenFilename("Data Files (*.xlsx),*.xlsx", Title:="Select the Data File"))
    Set wbLegacy = Workbooks.Open("C:\Path\Legacy.xls")

    wbLegacy.Worksheets("Sheet4").Range("D44").Value = wbLegacy.Worksheets("Sheet1").Range("C5").Value
    wbLegacy.Worksheets("Sheet4").Range("F54").Value = wbLegacy.Worksheets("Sheet1").Range("C6").Value
    wbLegacy.Worksheets("Sheet4").Range("G64").Value = wbLegacy.Worksheets("Sheet1").Range("C7").Value
    wbLegacy.Worksheets("Sheet4").Range("H74").Value = wbLegacy.Worksheets("Sheet1").Range("C8").Value
    wbLegacy.Worksheets("Sheet4").Range("A12").Value = wbLegacy.Worksheets("Sheet1").Range("C9").Value
    wbLegacy.Worksheets("Sheet4").Range("B14").Value = wbLegacy.Worksheets("Sheet1").Range("C10").Value
    'ad naseum.....

    wbLegacy.SaveAs Replace(wbData.FullName, ".xls", " in legacy format.xls")
    wbData.Close False
    wbLegacy.Close False

    End Sub


    Friday, January 31, 2014 5:23 PM
  • Thanks Bernie!

    I would like to build an array on a new sheet in Workbook "A" that contains the the copy from / to parameters.  Could the code above be changed or written in such a way to get the (Copy From Workbook "A" :) sheetname "A3" and Cell "B3" and then (wbLegacy, PasteSpecial) sheetname "D3" and Cell "E3". Then the next row and so on?

    Your Thoughts?

    Something like.
    sample


    heads up

    Sunday, February 2, 2014 2:58 PM
  • Try naming that new sheet "Parameters" and lay it out the way you show, and use code like this

    Sub TestMacro()

    Dim wbLegacy As Workbook
    Dim wbData As Workbook
    Dim shtParam As Worksheet
    Dim lngR As Long

    Set wbData = ThisWorkbook
    Set shtParam = wbData.Worksheets("Parameters")
    Set wbLegacy = Workbooks.Open("C:\Path\Legacy.xls")

    For lngR = 3 To shtParam.Cells(Rows.Count, "A").End(xlUp).Row
        wbLegacy.Worksheets(shtParam.Cells(lngR, "D").Value).Range(shtParam.Cells(lngR, "E").Value).Value = _
        wbData.Worksheets(shtParam.Cells(lngR, "A").Value).Range(shtParam.Cells(lngR, "B").Value).Value
    Next lngR

    wbLegacy.SaveAs Replace(wbData.FullName, ".xls", " in legacy format.xls")
    wbData.Close False
    wbLegacy.Close False

    End Sub

    Monday, February 3, 2014 2:39 PM
  • Hi Bernie,

    Getting the Error 9 Subscript out of error.

    For lngR = 3 To shtParam.Cells(Rows.Count, "A").End(xlUp).Row
        wbLegacy.Worksheets(shtParam.Cells(lngR, "D").Value).Range(shtParam.Cells(lngR, "E").Value).Value = _
        wbData.Worksheets(shtParam.Cells(lngR, "A").Value).Range(shtParam.Cells(lngR, "B").Value).Value
    Next lngR

    Your Thoughts?


    heads up


    Tuesday, February 4, 2014 8:44 PM
  • I know your testing me....

    Should this not read something like?

    From:wbLegacy.Worksheets("Sheet4").Range("B14").Value = wbLegacy.Worksheets("Sheet1").Range("C10").Value

    To: wbData.Worksheets("Sheet4").Range("B14").Value = wbLegacy.Worksheets("Sheet1").Range("C10").Value

    WbData to Legacy, not legacy to legacy? Just checking..


    heads up

    Tuesday, February 4, 2014 8:55 PM
  • One of the values in A or D is not a valid sheet name (look for extra blanks)

    One of the values in B or E is not a valid cell address (again, look for extra blanks)

    Tuesday, February 4, 2014 9:04 PM
  • It was a test, and you passed, but it should be

    wbLegacy.Worksheets("Sheet4").Range("B14").Value = wbData.Worksheets("Sheet1").Range("C10").Value

    You want to pass the data to the legacy workbook from the data workbook

     Sorry about that - I was not editing correctly.



    Tuesday, February 4, 2014 9:05 PM
  • Yes it was spaces, found the =trim tool that worked well. I got busted on the "program to long" with the other approach. This works as advertised and very quick. Good job!

    So I have a tweak that I can't figure out. On my workbook "A" sheet1, I have a cell B41 that creates a filename built with the concat formula. I would like a decision box to proceed with the save, and with a Yes, use the filename from B41 and send the file to a specific directory ( path).  Save the updated legacy file with this new file name. .   Thank you!


    heads up

    Wednesday, February 5, 2014 1:13 AM
  • Try

    If MsgBox("Save the file?", vbYesNo) = vbYes Then
    wbLegacy.SaveAs "C:\Specific Path\" & ThisWorkbook.Worksheets("Sheet1").Range("B41").Value
    End If

    though it would probably be better to name that cell so that if it ever moves your code won't break.

    If MsgBox("Save the file?", vbYesNo) = vbYes Then
    wbLegacy.SaveAs "C:\Specific Path\" & ThisWorkbook.Worksheets("Sheet1").Range("FileSaveName").Value
    End If

    Wednesday, February 5, 2014 4:05 PM
  • Yes,I learned the named cell the hardway! School of hard knocks.

    Question' If I use a cell (Named "Satellite") that contains a number from 1-12, and those numbers equal 1=D, 2=I, 3=J,4=K,5=J,6=K,7=L,8=M,9=N,10=O,11=P,12=Q. This cross reference replaces "E" below. Rather than copy this formula 12 times, there must be a smarter way to create a variable to do this? ("A","D" and"B" are constants.) Thank you 

    For lngR = 3 To shtParam.Cells(Rows.Count, "A").End(xlUp).Row
        wbLegacy.Worksheets(shtParam.Cells(lngR, "D").Value).Range(shtParam.Cells(lngR, "E").Value).Value = _
        wbData.Worksheets(shtParam.Cells(lngR, "A").Value).Range(shtParam.Cells(lngR, "B").Value).Value
    Next lngR


    heads up


    Tuesday, February 11, 2014 3:03 PM
  • Try it this way:

    Dim strCol As String
    strCol = Mid("DIJKJKLMNOPQ", Range("Satellite").Value, 1)

    For lngR = 3 To shtParam.Cells(Rows.Count, "A").End(xlUp).Row
        wbLegacy.Worksheets(shtParam.Cells(lngR, "D").Value).Range(shtParam.Cells(lngR, strCol).Value).Value = _
        wbData.Worksheets(shtParam.Cells(lngR, "A").Value).Range(shtParam.Cells(lngR, "B").Value).Value
    Next lngR


    Tuesday, February 11, 2014 5:39 PM
  • Bernie,

    The variable is counting proper, but once inserted in place of "E", things are not happy, no error to report?

    Your thoughts


    heads up

    Tuesday, February 11, 2014 9:17 PM
  • What do the message boxes say?

    Dim strCol As String
    strCol = Mid("DIJKJKLMNOPQ", Range("Satellite").Value, 1)

    Msgbox "The column is " & strCol

    Msgbox "The address is " & shtParam.Cells(lngR, strCol).Address

    Msgbox "The value in that cell is " & shtParam.Cells(lngR, strCol).Value

    For lngR = 3 To shtParam.Cells(Rows.Count, "A").End(xlUp).Row
        wbLegacy.Worksheets(shtParam.Cells(lngR, "D").Value).Range(shtParam.Cells(lngR, strCol).Value).Value = _
        wbData.Worksheets(shtParam.Cells(lngR, "A").Value).Range(shtParam.Cells(lngR, "B").Value).Value
    Next lngR


    Tuesday, February 11, 2014 9:34 PM
  • Msgbox "The column is " & strCol  (J) from Sat 3

    Msgbox "The address is " & shtParam.Cells(lngR, strCol).Address (This is hanging up, not getting to msgbox)


    heads up

    Tuesday, February 11, 2014 9:45 PM
  • My bad - lngR was not yet set:

    Dim strCol As String
    strCol = Mid("DIJKJKLMNOPQ", Range("Satellite").Value, 1)

    For lngR = 3 To shtParam.Cells(Rows.Count, "A").End(xlUp).Row

    Msgbox "The column is " & strCol

    Msgbox "The address is " & shtParam.Cells(lngR, strCol).Address

    Msgbox "The value in that cell is " & shtParam.Cells(lngR, strCol).Value

    Exit Sub
        wbLegacy.Worksheets(shtParam.Cells(lngR, "D").Value).Range(shtParam.Cells(lngR, strCol).Value).Value = _
        wbData.Worksheets(shtParam.Cells(lngR, "A").Value).Range(shtParam.Cells(lngR, "B").Value).Value
    Next lngR

    Tuesday, February 11, 2014 11:33 PM
  • Msgbox "The column is " & strCol (J)

    Msgbox "The address is " & shtParam.Cells(lngR, strCol).Address (D35)

    Msgbox "The value in that cell is " & shtParam.Cells(lngR, strCol).Value (Constants)


    heads up

    Tuesday, February 11, 2014 11:54 PM
  • So, is there a named range "Constants" on that sheet?

    Try troubleshooting like this:

    Dim strCol As String
    strCol = Mid("DIJKJKLMNOPQ", Range("Satellite").Value, 1)

    For lngR = 3 To shtParam.Cells(Rows.Count, "A").End(xlUp).Row

    Msgbox "The column is " & strCol

    Msgbox "The address is " & shtParam.Cells(lngR, strCol).Address

    Msgbox "The value in that cell is " & shtParam.Cells(lngR, strCol).Value

    Msgbox  "The sheet is " & shtParam.Cells(lngR, "D").Value

    Msgbox "The Cell is " & wbLegacy.Worksheets(shtParam.Cells(lngR, "D").Value).Range(shtParam.Cells(lngR, strCol).Value).Address


        wbLegacy.Worksheets(shtParam.Cells(lngR, "D").Value).Range(shtParam.Cells(lngR, strCol).Value).Value = _
        wbData.Worksheets(shtParam.Cells(lngR, "A").Value).Range(shtParam.Cells(lngR, "B").Value).Value
    Next lngR

    Wednesday, February 12, 2014 2:28 AM
  • Bernie,

    I think its the nature of the form I am importing into. The inconsitant nature of merge cells is throwing it into the weeds. The code does work but stumbles with the odd nature of the cells. I can work with the first version just fine. Thank you!


    heads up

    Wednesday, February 12, 2014 3:20 AM
  • Bernie,

    How does this formula get modified when I reach into the double letter columns like AA,AB,AC

    strCol = Mid("DIJKJKLMNOPQ", Range("Satellite").Value, 1)

    thanks


    heads up

    Thursday, February 13, 2014 4:30 AM
  • 1) For each column letter, use three characters, padded with spaces.

    For the first 26 columns <space><space>A 

    For the next <space>AA,  etc.

    Like so:

    x = Range("Satellite").Value
    strcol = Trim(Mid("  D  I  J  K  J  K  L  M  N  O  P  Q AA AB AG  A AG", (x - 1) * 3 + 1, 3))
    MsgBox strcol

    2) use an array of values

    x = Range("Satellite").Value
    strcol = Array("D", "I", "J", "K", "J", "K", "L", "M", "N", "O", "P", "Q", "AA", "AB", "AG", "A", "AG")(x - 1)
    MsgBox strcol

    With the code, if you are off by one letter, then your option base may be set to 1 instead of 0, in which case remove the -1 from (x -1) (if you don'[t know what option base is, it is probably the default which is 0)

    Thursday, February 13, 2014 3:24 PM