Range for Merged Cells

[rct2323]

Hi,
I am having trouble with the following line of code though. I have merged cells J through P. How can I select the merged? It works fine for just one cell, but not for merged cells. For one cell, I just put the column of the cell in quotes. I am trying to copy data from 1 sheet to another sheet in the same workbook when a cell equals "Issue".

'Range("J", "K", "L", "M", "N", "O", "P" & CStr(LCurTRow)).Select"


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
'Dim rngSource As Range, rngTarget As Range

'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 E 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 H 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

'Copy values from columns H from RISK REGISTER SAMPLE sheet
Sheets(LSheetMain(6)).Select
'Range("J", "K", "L", "M", "N", "O", "P" & CStr(LCurTRow)).Select
Range("J" & CStr(LCurTRow)).Select
Selection.Copy

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




'RISK REGISTER SAMPLE has A1:B1 as a merged cell (7 cells merged together)
'Set rngSource = LSheetMain(6).Range("J9")

'LSheetT has A1:C1 as a merged cell (3 cells merged together)
'NB: the size of rngTarget is different to the size of rngSource
'Set rngTarget = LSheetT(2).Range("I18")

'rngTarget.Value = rngSource.Value



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

 

[Golom]

Looks more like VBA so you should be in forum707.

Try

Range("J" & CStr(LCurTRow)  & ":P" & CStr(LCurTRow)).Select

 

[rct2323]

Hi,
Sorry about mis posting, I am new at this. I still get an error on the following line:

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

My source sheet has 6 merged cells and my destination has 3 merged cells.

Here is the code for that section:
'Copy values from columns H 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


How can I change all the code so the macro does not copy the same data over from the source? So if a record from the source has already been copied it won't be copied again?
Thanks,

 

[johnwm]

Rather than persisting in the wrong forum, just repost in forum707

That will save you losing your question and answers when the thread gets dumped as being off-topic.

___________________________________________________________
If you want the best response to a question, please check out FAQ222-2244 first.
'If we're supposed to work in Hex, why have we only got A fingers?'
Drive a Steam Roller
Steam Engine Prints