Copy Paste Data from Sheet 1 to Sheet 2

[Silver]

Hello,

Got 2 sheets Sheet1 and Sheet2.

Sheet1 is were all the datas are maintained and Sheet2 is were report is generated from Sheet1.

The report is generated based on specific columns from Sheet1 and then pasted to specific columns in Sheet2.

Below is the code which achieves this :



Private Sub CommandButton1_Click()
Sheets("Sheet1").Columns("A").Copy Sheets("Sheet2").Columns("O")
Sheets("Sheet1").Columns("B").Copy Sheets("Sheet2").Columns("H")
Sheets("Sheet1").Columns("C").Copy Sheets("Sheet2").Columns("F")
Sheets("Sheet1").Columns("D").Copy Sheets("Sheet2").Columns("P")
Sheets("Sheet1").Columns("E").Copy Sheets("Sheet2").Columns("A")
Sheets("Sheet1").Columns("F").Copy Sheets("Sheet2").Columns("D")
Sheets("Sheet1").Columns("G").Copy Sheets("Sheet2").Columns("K")
Sheets("Sheet1").Columns("H").Copy Sheets("Sheet2").Columns("I")
Sheets("Sheet1").Columns("I").Copy Sheets("Sheet2").Columns("J")
Sheets("Sheet1").Columns("J").Copy Sheets("Sheet2").Columns("L")
Sheets("Sheet1").Columns("K").Copy Sheets("Sheet2").Columns("B")
Sheets("Sheet1").Columns("L").Copy Sheets("Sheet2").Columns("G")
Sheets("Sheet1").Columns("M").Copy Sheets("Sheet2").Columns("E")
End Sub



Looking for few additions as below :

1) Whenever the report is generated Column N in Sheet2 should also be updated with number 1.

2) Since the data in Sheet1 is vast, I need a pop-up box asking for row number and performs the above task from the row number specified and paste the data on the next empty row in Sheet2.

3) Need a button on Sheet2 which will run the macro.

Have attached sample sheet with Dummy Data

[Silver]

Can the above mentioned additions be achieved row wise.

This is what I would like the macro to do -

1) When clicked on the command button a pop-up should ask me for Row Number.

2) If I enter Row Number as 2, the macro should copy all the relevant data from Row 2 as per the Ranges mentioned in the code from Sheet1.

(The code has Columns A,B,C,D and so on, which should be Range A,B,C,D )

3) When macro pastes the data on Sheet2, the data should be pasted as per the ranges mentioned in the code. Also Column N should get updated with number 1.

(The code has Columns O,H,F,P and so on which should be Range O,H,F,P )

4) Macro should paste the data in Sheet2 on the next empty row.

[Silver]

Hope this explanation Helps

Task 1

If Range F has keywords AAAAA and/or BBBBB, macro should copy data from
Range B,C,D,E,F,H,I,J,K,M from Sheet1 and paste it to
Range H,F,P,A,D,I,J,L,B,E of Sheet2

Task 2

If Range F has any other keywords other than AAAAA and/or BBBBB,
macro should copy data from Sheet1
Range A,B,C,D,E,F,G,K,L,M and paste it to
Range O,H,F,P,A,D,K,B,G,E of Sheet2

All this should be achieved through a pop-up box asking for Row Number.

So if I enter Row Number as 3, macro should perform both the above mentioned tasks.

The data should be pasted on the next empty row available on Sheet2

[mperrah]

Try this

Sub copySht1toSht2()
Dim lr, x, a As Integer
Dim ws1, ws2 As Worksheet
Dim rTrgt As Integer
Dim aSrc(), aDst() As Variant

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

lr = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1

rTrgt = InputBox("Enter Row Number")

ReDim aSrc(13)

For x = 0 To 12
aSrc(x) = ws1.Cells(rTrgt, x + 1).Value
Next x

aDst = Array("O", "H", "F", "P", "A", "D", "K", "I", "J", "L", "B", "G", "E")

For a = 0 To 12
ws2.Cells(lr, aDst(a)) = aSrc(a)
Next a

ws2.Cells(lr, "N").Value = ws2.Cells(lr - 1, "N") + 1
'ws2.Cells(lr, "N").Value = rTrgt ' not sure if you are adding 1 or the comment 1 which is row number from input..




End Sub

[mperrah]

re post #3

task 1 looks for Range F values, is that from sheet 1 or sheet 2?
and why do you now skip column "A" for task 1 change from post#1

task 2
now you are changing source and destination ranges?
please decide what you want and were and why.

[mperrah]

If you mean Sht1 column D, try this.
If your checking sheet 2 for "AAAAA" then something else is needed...


Sub copySht1toSht2_v2()

'If Range F (Sht1 D?) has keywords AAAAA and/or BBBBB
'Range B,C,D,E,F,H,I,J,K,M from Sheet1 and paste it to
'Range H,F,P,A,D,I,J,L,B,E of Sheet2

'If Range F (sht1 D?) has any other keywords other than AAAAA and/or BBBBB,
'Range A,B,C,D,E,F,G,K,L,M and paste it to
'Range O,H,F,P,A,D,K,B,G,E of Sheet2

Dim lr, x, a As Integer
Dim ws1, ws2 As Worksheet
Dim rTrgt As Integer
Dim aSrc1(), aSrc2(), aDst1(), aDst2() As Variant

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

lr = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1

ReDim aSrc1a(10)
ReDim aSrc2a(10)
aSrc1 = Array("B", "C", "D", "E", "F", "H", "I", "J", "K", "M")
aSrc2 = Array("A", "B", "C", "D", "E", "F", "G", "K", "L", "M")
aDst1 = Array("H", "F", "P", "A", "D", "I", "J", "L", "B", "E")
aDst2 = Array("O", "H", "F", "P", "A", "D", "K", "B", "G", "E")

rTrgt = InputBox("Enter Row Number")

If ws1.Cells(rTrgt, "D") = "AAAAA" Or _
ws1.Cells(rTrgt, "D") = "BBBBB" Then
For x = 0 To 9
aSrc1a(x) = ws1.Cells(rTrgt, aSrc1(x)).Value
Next x

For a = 0 To 9
ws2.Cells(lr, aDst1(a)) = aSrc1a(a)
Next a

Else
For x = 0 To 9
aSrc2a(x) = ws1.Cells(rTrgt, aSrc2(x)).Value
Next x

For a = 0 To 9
ws2.Cells(lr, aDst2(a)) = aSrc2a(a)
Next a
End If

ws2.Cells(lr, "N").Value = ws2.Cells(lr - 1, "N") + 1
'ws2.Cells(lr, "N").Value = rTrgt

End Sub

[Silver]

Exactly what I'm looking for.

Just need a minor addition.

Range M in Sheet1 will be updated with value and comments or both, I want macro to update the same in Range E in Sheet2

[mperrah]

comment like text in the cell or an inserted comment that shows when you hover?
The code already copies sht1M to sht2E

are you saying after running the code an update can happen later?
If so, we could add a worksheet_change event to find a match of a unique value in both sheets to place the updated value...

[Silver]

Yes - An inserted comment that shows when you hover.

The comment is inserted before the macro is run in Sheet 1 Range M.

When the macro is run it should copy and paste the same in Range E in Sheet2.

Note -

Range M in sheet will be updated with Value or comment or both.
So macro should be able to copy whatever is entered in Range M in sheet1 and copy the same to Range E in Sheet2

[mperrah]

The code from post#6 already does that per request in post#3

if Column F has AAAAA/BBBBB or not, both parts of the code pulls from sht1 M and pastes to sht2 E
have you tried it? are you getting an error?

[Silver]

The code does everything correctly, except for the comment part.

If Range M in Sheet1 has comment the result is Range E in Sheet2 is left blank.

Refer below snapshot

[mperrah]

Try this


Sub copySht1toSht2_v3()
Dim lr, x, a As Integer
Dim ws1, ws2 As Worksheet
Dim rTrgt As Integer
Dim aSrc1(), aSrc2(), aDst1(), aDst2() As Variant

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

lr = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1

ReDim aSrc1a(9)
ReDim aSrc2a(9)
aSrc1 = Array("B", "C", "D", "E", "F", "H", "I", "J", "K")
aDst1 = Array("H", "F", "P", "A", "D", "I", "J", "L", "B")
aSrc2 = Array("A", "B", "C", "D", "E", "F", "G", "K", "L")
aDst2 = Array("O", "H", "F", "P", "A", "D", "K", "B", "G")

rTrgt = InputBox("Enter Row Number")

If ws1.Cells(rTrgt, "D") = "AAAAA" Or _
ws1.Cells(rTrgt, "D") = "BBBBB" Then
For x = 0 To 8
aSrc1a(x) = ws1.Cells(rTrgt, aSrc1(x)).Value
Next x

For a = 0 To 8
ws2.Cells(lr, aDst1(a)) = aSrc1a(a)
Next a

ws1.Cells(rTrgt, "M").Copy
ws2.Cells(lr, "E").PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Else
For x = 0 To 8
aSrc2a(x) = ws1.Cells(rTrgt, aSrc2(x)).Value
Next x

For a = 0 To 8
ws2.Cells(lr, aDst2(a)) = aSrc2a(a)
Next a

ws1.Cells(rTrgt, "M").Copy
ws2.Cells(lr, "E").PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

End If

ws2.Cells(lr, "N").Value = ws2.Cells(lr - 1, "N") + 1 ' just incriments value
'ws2.Cells(lr, "N").Value = rTrgt ' copies row number values were copied from

End Sub

[Silver]

Thanks...