Copy Cell To Another Workbook Sheet

[DCBUS]

Hello,
I am using the below Macro to copy Colomn "C" in sheet1 to Column "D" in sheet 2. I was wondering if it is possible instead of having predetermined copy and paste columns, that I can specify when the Macro is run. Meaning when I run the Macro, I get a dialog box that pops up that allows me to enter the sheet1 column for copy and once I enter that column, the next box pops up for me to enter the sheet2 destination column?

Option Explicit

Sub CtoD()
Dim wsOne As Worksheet, wsTwo As Worksheet
Dim arrOne, arrTwo, j As Long, jj As Long
Dim lrOne As Long, lrTwo As Long
Set wsOne = Worksheets("Sheet1")
Set wsTwo = Worksheets("Sheet2")


lrOne = wsOne.Cells(Rows.Count, "A").End(xlUp).Row
lrTwo = wsTwo.Cells(Rows.Count, "A").End(xlUp).Row


arrOne = wsOne.Range("A1:C" & lrOne).Value2
arrTwo = wsTwo.Range("A1:D" & lrTwo).Value2


For j = LBound(arrOne) To UBound(arrOne)
        For jj = LBound(arrTwo) To UBound(arrTwo)
            If arrTwo(jj, 1) = arrOne(j, 1) Then
                arrTwo(jj, 4) = arrOne(j, 3)
            End If
        Next jj
Next j
wsTwo.Range("A1").Resize(UBound(arrTwo), 4).Value = arrTwo


End Sub

Thanks Jr

 

[DCBUS]

Hello,
Thank you very much and I apologize for the late reply. It works exactly how I need to work. Thank you!!!!

 

[DCBUS]

Hello offthelip,

I was using the below macro you helped me with some time ago, and it works as written. My error in the explanation, I need it to compare column "A" in both WS1 and WS2 which is the master for each sheet. When that same identifier is found in column "A" in both WS1 and WS2, it will copy over from WS1 to WS2 with the use of your macro with source and destination that I can define. Right now it is copying over directly and not matching source in column "A".

Current Code:

[COLOR=#333333]Sub CtoD()[/COLOR]
Dim wsOne As Worksheet, wsTwo As Worksheet
Dim arrOne, arrTwo
Dim lrOne As Long
Set wsOne = Worksheets("Sheet1")
Set wsTwo = Worksheets("Sheet2")
Scol = InputBox("type in the source column letter code")
Scol = UCase(Scol)
Dcol = InputBox("type in the destination column letter code")
Dcol = UCase(Dcol)
lrOne = wsOne.Cells(Rows.Count, Scol).End(xlUp).Row
arrOne = wsOne.Range(Scol & "1:" & Scol & lrOne).Value2
wsTwo.Range(Dcol & "1:" & Dcol & lrOne).Value2 = arrOne

 [COLOR=#333333]End Sub[/COLOR]

Thank you very much,
JR

 

[offthelip]

when you say

compare column "A"

, what do you mean? do you mean compare just the first row and then copy the whole column across, or do you mean compare each row in WS1.column A with the same row number in WS2.column A and copy just the rows with the same in both cells, or do you mean search for each row in WS1 column A search through ws2.column A to see if any of the rows match and if so copy the ws1 row to that row in ws2. All of these apart from the fisrt option are radically different to your orignal question

 

[DCBUS]

Hello,
Thank you for the response. I hope below explains better what I am try to say. WS1 and WS2 are compared in column "A". If there is a match, then that data I choose in your popup box for source will copy to the popup box for destination. If there is no match in WS1 and WS2 column "A" there is nothing copied.

Thank you and sorry for the confusion.

WS1

A	B	C	D
1	AA
2	BB
3	CC
4	DD
5	EE

<tbody>
</tbody>

WS2

A	B	C	D
11
2		BB
35
4		DD
55

<tbody>
</tbody>

 

[offthelip]

this code will do it for you:

Sub CtoD()
Dim wsOne As Worksheet, wsTwo As Worksheet
Dim arrOne, arrTwo
Dim lrOne As Long
Set wsOne = Worksheets("Sheet1")
Set wsTwo = Worksheets("Sheet2")
scol = InputBox("type in the source column letter code")
scol = UCase(scol)
dcol = InputBox("type in the destination column letter code")
dcol = UCase(dcol)
lrOne = wsOne.Cells(Rows.Count, scol).End(xlUp).Row
With wsOne
cola1 = Range(.Cells(1, 1), .Cells(lrOne, 1))
End With
With wsTwo
cola2 = Range(.Cells(1, 1), .Cells(lrOne, 1))
End With
   
 For i = 1 To lrOne
  If (cola1(i, 1) = cola2(i, 1)) Then
  Worksheets("Sheet1").Range(scol & i).Copy Worksheets("Sheet2").Range(dcol & i)
  End If
Next i




 End Sub

 

[DCBUS]

Hello offthelip,

Thank you very much. I tried it and was able to make it work only after WS1 and WS2 column "A" was sorted A-Z. If WS1 and WS2 had equal content in "A", and was not sorted, it would not copy over, but as soon as I would sort A-Z by column "A", it would then copy over the correct values. Is it possible to have it copy if column "A" in WS1 and WS2 are not sorted.

Thank you very much
JR

 

[offthelip]

in my post #13 I clearly stated:

what do you mean? do you mean compare just the first row and then copy the whole column across, or do you mean compare each row in WS1.column A with the same row number in WS2.column A and copy just the rows with the same in both cells, or do you mean search for each row in WS1 column A search through ws2.column A to see if any of the rows match and if so copy the ws1 row to that row in ws2. All of these apart from the first option are radically different to your original question

I gave you 3 options, your response was not to clearly state which option you wanted but to give me an example and the example quite clearly had option 2 indicated , i.e. copy across when ever the same row had the same number in it. What you have now decided is that you want option 3, I have produced two variants of this to your poorly specified requirements and now you are asking for a third. If you were paying the bill for this ......

 

[offthelip]

this should do it, (untested)

Sub CtoD()

Dim wsOne As Worksheet, wsTwo As Worksheet
Dim arrOne, arrTwo
Dim lrOne As Long
Set wsOne = Worksheets("Sheet1")
Set wsTwo = Worksheets("Sheet2")
scol = InputBox("type in the source column letter code")
scol = UCase(scol)
dcol = InputBox("type in the destination column letter code")
dcol = UCase(dcol)
lrOne = wsOne.Cells(Rows.Count, scol).End(xlUp).Row
With wsOne
cola1 = Range(.Cells(1, 1), .Cells(lrOne, 1))
End With
lrTwo = wsOne.Cells(Rows.Count, scol).End(xlUp).Row


With wsTwo


cola2 = Range(.Cells(1, 1), .Cells(lrTwo, 1))
End With
   
 For i = 1 To lrOne
   For j = 1 To lrTwo
  If (cola1(i, 1) = cola2(j, 1)) Then
  Worksheets("Sheet1").Range(scol & i).Copy Worksheets("Sheet2").Range(dcol & j)
  End If
  Next j
Next i

 

[DCBUS]

Hello,
Thank you and all you had to do is ask and I would have kindly paid you. What is your Paypal id and I will send you some funds. I will not even try the third option until I have sent some funds to you. Sorry if it was not explained as to your expectations, but you are much more advanced than me on this so I apologize. Please send me the Payment ID so I can use this macro, otherwise it is just wasted and will not be used..

JR

 

[offthelip]

Hi DCbus, Thanks very much for the offer to pay, I was not trying to imply that you should. The situation reminded me of a time early in my career as a software developer where I worked for a project manager who insisted that we delivered software that did what the customer asked for, (not what he wanted) this was so that the customer had to pay us again to modify the software to meet what he actually wanted. Needless to say it was fairly frustrating writing software when we knew it was complete rubbish and not what the customer wanted. If you insist on paying before using the third lot of software, can I ask you to make a donation to a cancer charity of your choice , such as Cancer Research Uk. This is because I was diagnosed with Cancer last year, hopefully clear now, but still having ongoing checks.