Macro to Copy Data Between Sheets

[rct2323]

Hi,
I am trying to copy certain cells from 1 sheet to another based on a trigger. In sheet RISK REGISTER SAMPLE, if the Status changes to Issue I want to copy certain cells to the sheet ISSUES MGMT SAMPLE. I am having the following issues:
1. I want a record to only copy once so if a record in sheet ISSUES MGMT SAMPLE is modified it won't be overwritten the next time the macro runs.
2. When a record is copied, instead of copying " Range("B" & CStr(LRow)).Select" I want to copy the word "Open" to "Range("b" & CStr(LCurTRow)).Select" because every new item will have an initial status of Open.
3. I can not copy cells that are merged from 1 sheet to another. The source sheet has 6 merged cells and the destination has 3 merged cells.

Can someone please help??

Here is the entire code:

Sub CopyData()

Dim LSheetMain, LSheetP, LSheetS, LSheetT As String
Dim LContinue As Boolean
Dim LFirstRow, LRow As Integer
Dim LCurPRow, LCurSRow, LCurTRow As Integer

'Set up names of sheets
LSheetMain = "RISK REGISTER SAMPLE"
LSheetT = "ISSUES MGMT SAMPLE"

'Initialize variables
LContinue = True
LFirstRow = 9
LRow = LFirstRow
LCurTRow = 24



Sheets(LSheetMain).Select

'Loop through all column B values until a blank cell is found
While LContinue = True

'Found a blank cell, do not continue
If Len(Range("b" & CStr(LRow)).Value) = 0 Then
LContinue = False

'--- "Issue" ---
ElseIf Range("b" & CStr(LRow)).Value = "Issue" Then

'Copy values from columns B from RISK REGISTER SAMPLE sheet
Range("B" & CStr(LRow)).Select
Selection.Copy

'Paste onto "ISSUES MGMT SAMPLE" sheet
Sheets(LSheetT).Select
Range("b" & CStr(LCurTRow)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Copy values from columns C from RISK REGISTER SAMPLE sheet
Sheets(LSheetMain).Select
Range("C" & CStr(LRow)).Select
Selection.Copy

'Paste onto "ISSUES MGMT SAMPLE" sheet
Sheets(LSheetT).Select
Range("C" & CStr(LCurTRow)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Range("b1").Select

'Copy values from columns D from RISK REGISTER SAMPLE sheet
Sheets(LSheetMain).Select
Range("D" & CStr(LRow)).Select
Selection.Copy

'Paste onto "ISSUES MGMT SAMPLE" sheet
Sheets(LSheetT).Select
Range("D" & CStr(LCurTRow)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Range("b1").Select

'Copy values from columns G from RISK REGISTER SAMPLE sheet
Sheets(LSheetMain).Select
Range("G" & CStr(LRow)).Select
Selection.Copy

'Paste onto "ISSUES MGMT SAMPLE" sheet
Sheets(LSheetT).Select
Range("E" & CStr(LCurTRow)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


'Copy values from columns H from RISK REGISTER SAMPLE sheet
Sheets(LSheetMain).Select
Range("H" & CStr(LRow)).Select
Selection.Copy

'Paste onto "ISSUES MGMT SAMPLE" sheet
Sheets(LSheetT).Select
Range("F" & CStr(LCurTRow)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Copy values from columns I from RISK REGISTER SAMPLE sheet
Sheets(LSheetMain).Select
Range("I" & CStr(LRow)).Select
Selection.Copy

'Paste onto "ISSUES MGMT SAMPLE" sheet
Sheets(LSheetT).Select
Range("G" & CStr(LCurTRow)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'THIS IS NOT WORKING, I WANT TO BE ABLE TO COPY MERGED CELLS
'Copy values from columns J from RISK REGISTER SAMPLE sheet
Sheets(LSheetMain).Select
'Range("J", "K", "L", "M", "N", "O", "P" & CStr(LCurTRow)).Select
Range("J" & CStr(LCurTRow) & "" & CStr(LCurTRow)).Select
Selection.Copy

'Paste onto "ISSUES MGMT SAMPLE" sheet
Sheets(LSheetT).Select
'Range("I", "J", "K" & CStr(LCurTRow)).Select
Range("J" & CStr(LCurTRow) & ":K" & CStr(LCurTRow)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False



Range("b1").Select


'Increment row counter on "ISSUES MGMT SAMPLE" sheet
LCurTRow = LCurTRow + 1

'Go back to RISK REGISTER SAMPLE sheet and continue where left off
Sheets(LSheetMain).Select


End If


LRow = LRow + 1

Wend
MsgBox "The issues have successfully been copied."
End Sub

 

[SkipVought]

Hi,

"I can not copy cells that are merged from 1 sheet to another."

You cannot because...
[tt]
a. Excel won't allow you to copy
or
b. Your logic doe not permit you to copy.
[/tt]
I'm guessing the former. Merged cells are a bear to work with. You'll need logic to ...
[tt]
1. determine the MergedArea ranges
2. Unmerge the ranges
3. copy
4. paste
5. remerge the ranges
[/tt]
check out the MergeArea & MergeCells properties.

"I want to copy the word "Open""

You cannot copy words, values etc. You can copy a range that contains the value "Open", but why go to all that bother. Just assign the destination range the value "Open"...

Range("B" & LRow).Value = "Open"

I prefer the notation...

Cells(LRow, "B").Value = "Open"

Copy 'n' Paste...

'Copy values from columns B from RISK REGISTER SAMPLE sheet
'Paste onto "ISSUES MGMT SAMPLE" sheet
Cells(LRow, "B").Copy 
Sheets(LSheetT).Cells(LCurTRow, "b").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Skip,
[sub]
Just traded in my old subtlety...
for a brand NUANCE![/sub]

 

[rct2323]

How do I modify the macro so it does not start from the beginning every time?
thanks

 

[SkipVought]

Change the values assigned to LFirstRow & LCurTRow.

maybe...

LFirstRow = Cells(9, "b").end(xldown).Row + 1

Skip,
[sub]
Just traded in my old subtlety...
for a brand NUANCE![/sub]