Copy values from seperate merged cells into one merged cell as coordinates seperated by a comma-CodePudding

I am a beginner in VBA. I am trying to copy data from 1 workbook to another, specifically data from 2 merged cells into 1 merged cell as coordinates.

Cell 1 = 58.634
Cell 2 = 63.458
Destination Cell = 58.634, 63.458

And I also need to do the operation in reverse, as in: retrieve the individual values from the coordinates cell seperated by a comma and paste them into 2 seperate (merged) cells.

As of right now, my code simply consists of a succession of simple copy/paste of data over multiple cells. Multiple lines of this:

Workbooks("Origin file.extension").Worksheets("sheet1").Range(" ").Copy
Workbooks("Destination file.extension").Worksheets("sheet1").Range("  ").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

CodePudding user response：

I have commented the code. Let me know if you still have a question?

Is this what you are trying? (UNTESTED)

Option Explicit

Sub Sample()
    Dim wbOrigin As Workbook
    Dim wbDest As Workbook
    
    '~~> Change this to the relevant workbooks
    Set wbOrigin = Workbooks("Origin file.extension")
    Set wbDest = Workbooks("Destination file.extension")
    
    Dim wsOrigin As Worksheet
    Dim wsDest As Worksheet
    
    '~~> Change this to the relvant worksheets
    Set wsOrigin = wbOrigin.Sheets("Sheet1")
    Set wsDest = wbDest.Sheets("Sheet1")
    
    Dim rngOriginMergedOne As Range
    Dim rngOriginMergedTwo As Range
    Dim rngMergedDest As Range
    
    '~~> Change these to the relevant merged cells
    Set rngOriginMergedOne = wsOrigin.Range("A1")
    Set rngOriginMergedTwo = wsOrigin.Range("D1")
    Set rngMergedDest = wsDest.Range("A1")
        
    '~~> This is the delimiter
    Dim delim As String: delim = ", "
    
    '~~> Combining two values
    rngMergedDest.Value = rngOriginMergedOne.Value2 & delim & rngOriginMergedTwo.Value2
End Sub

For the reverse, replace the line rngMergedDest.Value = rngOriginMergedOne.Value2 & delim & rngOriginMergedTwo.Value2 in the above code with the below lines.

'~~> The Reverse
rngOriginMergedOne.Value = Split(rngMergedDest.Value2, delim)(0)
rngOriginMergedTwo.Value = Split(rngMergedDest.Value2, delim)(1)

CodePudding user response：

Maybe I'm missing something so just to be sure hereunder a POC assuming all data is in sheet 1 col A. If this does what you want I'll add the external workbook etc:

    Sub merge()
        Dim arr, st, LastRow As Long
        With Sheet1
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'count rows from last row
            arr = .Range(.Cells(1, 1), .Cells(LastRow, 1)).Value2 'load col A of invoices
        End With
        
        st = WorksheetFunction.Transpose(arr)
        st = Join(st, ",")
        Sheet1.Range("D1") = st
    End Sub
    Sub Unmerge()
        Dim arr, st, LastRow As Long
        With Sheet1
            arr = Split(.Range("D1"), ",")
            .Range(.Cells(1, 5), .Cells(UBound(arr), 5)) = WorksheetFunction.Transpose(arr) 'dump updated array to customer sheet
        End With
    End Sub

CodePudding user response：

Fun Way to do it since there are answers already.

Sub CopyMergedCells()

Dim WrkBStart, WrkBDest As Workbook
Dim WrkSheet1, WrkSheet2 As Worksheet
Dim StartRng, EndRng, DestRng As Range
Dim delim As String: delim = ", "
Dim FirstDest, SecondDest, DestToMerge, MergedString As Variant

'Set workbooks
Set WrkBStart = Workbooks("1st WorkBook")
Set WrkBDest = Workbooks("2nd WorkBook")
'Set WorkSheets
Set WrkSheet1 = WrkBStart("1st WorSheet")
Set WrkSheet2 = WrkBDest("2nd WorkSheet")

'Determine what cells you want
'Start
FirstDest = Application.InputBox(prompt:="Enter 1st Cell", Type:=2)
SecondDest = Application.InputBox(prompt:="Enter 2nd Cell", Type:=2)
'Destination
DestOfCopy = Application.InputBox(prompt:="Enter Destination Cell", Type:=2)

'Copy From Start Location
ToCopy1 = Worksheets("Sheet2").Range(FirstDest).Value
ToCopy2 = Worksheets("Sheet2").Range(SecondDest).Value
MergedString = ToCopy1 & ", " & ToCopy2

'Paste To End location
Worksheets("Sheet2").Range(DestOfCopy).Select
Selection.UnMerge
Worksheets("Sheet2").Range(DestOfCopy).Select
Selection.Value = MergedString
DestToMerge = ActiveCell.Offset(0, 1).address
Range(DestOfCopy, DestToMerge).Select

'DestRng.Select
Selection.Merge

End Sub