Can I detect merged cell in one sheet and merge same cell in another sheet?

A

ArnMan

Board Regular
Joined
Aug 30, 2017
Messages
69
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hello,
I was wondering if it is possible to detect a merged cell or range on one sheet(Sheet1) and merge the same cells in another sheet(Sheet2)?
The columns being copied over go from B to H in a loop
I am copying them row by row until LastRow.

Not every cell in each B H range is going to be merged. Each row is going to be different.
Example B to C could be merged in 1 row
or B to E merged
or C to D merged or any combination.

Merging is the only formatting I want. I don't want interior colors and borders.
Is there a way to copy over the row in the loop
find which cells are merged Sheet1 and copy them over to the other sheet Sheet2? and retain values in whatever cells there are?

here is my code for copying

Code: 
Dim lRowAdd As Long
lRow = Sheets("Datasheet-C").Cells(Rows.Count, "AAA").End(xlUp).Row
lRowAdd = lRow
Dim i As Integer
    For i = 1 To lRowAdd
        
        Sheets("Datasheet-C").Range("AAA" & i).Value = 1
        
        Sheets("Accredited").Range("B" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("B" & i).Value = Sheets("Datasheet-C").Range("B" & i).Text
        Sheets("Accredited").Range("C" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("C" & i).Value = Sheets("Datasheet-C").Range("C" & i).Text
        Sheets("Accredited").Range("D" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("D" & i).Value = Sheets("Datasheet-C").Range("D" & i).Text
        Sheets("Accredited").Range("E" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("E" & i).Value = Sheets("Datasheet-C").Range("E" & i).Text
        Sheets("Accredited").Range("F" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("F" & i).Value = Sheets("Datasheet-C").Range("F" & i).Text
        Sheets("Accredited").Range("G" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("G" & i).Value = Sheets("Datasheet-C").Range("G" & i).Text
        Sheets("Accredited").Range("H" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("H" & i).Value = Sheets("Datasheet-C").Range("H" & i).Text
         
    Next
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
I've figured it out its not pretty and I am sure there is a faster way to do this or easier or less code or something.
but here is what I figured out and it is working for me.

Code: 
Sub CopyToAccredited()

Dim lRowAdd As Long
lRow = Sheets("Datasheet-C").Cells(Rows.Count, "AAA").End(xlUp).Row
lRowAdd = lRow
Dim i As Integer
    For i = 7 To lRowAdd
        
        Sheets("Datasheet-C").Range("AAA" & i).Value = 1
        
        Sheets("Datasheet-C").Range("B" & i & ":H" & i).Copy
        Sheets("Accredited").Range("B" & i & ":H" & i).PasteSpecial xlPasteFormats
        'Sheets("Accredited").Range("B" & i & ":H" & i).Borders.LineStyle = xlNone
        'Sheets("Accredited").Range("B" & i & ":H" & i).Interior.Color = xlNone
       
    If IsNumeric(Sheets("Datasheet-C").Range("B" & i)) = True Then
            
            Sheets("Accredited").Range("B" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("B" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("B" & i).Value = "=('Datasheet-C'!B" & i & ") & """""
    Else
            
            Sheets("Accredited").Range("B" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("B" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("B" & i) = "=T('Datasheet-C'!B" & i & ")"
    End If

    If IsNumeric(Sheets("Datasheet-C").Range("C" & i)) = True Then
            Sheets("Accredited").Range("C" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("C" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("C" & i).Value = "=('Datasheet-C'!C" & i & ") & """""
    Else
            Sheets("Accredited").Range("C" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("C" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("C" & i) = "=T('Datasheet-C'!C" & i & ")"
    End If
    If IsNumeric(Sheets("Datasheet-C").Range("D" & i)) = True Then
            Sheets("Accredited").Range("D" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("D" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("D" & i).Value = "=('Datasheet-C'!D" & i & ") & """""
    Else
            Sheets("Accredited").Range("D" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("D" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("D" & i) = "=T('Datasheet-C'!D" & i & ")"
    End If
    If IsNumeric(Sheets("Datasheet-C").Range("E" & i)) = True Then
            Sheets("Accredited").Range("E" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("E" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("E" & i).Value = "=('Datasheet-C'!E" & i & ") & """""
    Else
            Sheets("Accredited").Range("E" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("E" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("E" & i) = "=T('Datasheet-C'!E" & i & ")"
    End If
    If IsNumeric(Sheets("Datasheet-C").Range("F" & i)) = True Then
            Sheets("Accredited").Range("F" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("F" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("F" & i).Value = "=('Datasheet-C'!F" & i & ") & """""
    Else
            Sheets("Accredited").Range("F" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("F" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("F" & i) = "=T('Datasheet-C'!F" & i & ")"
    End If
    If IsNumeric(Sheets("Datasheet-C").Range("G" & i)) = True Then
            Sheets("Accredited").Range("G" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("G" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("G" & i).Value = "=('Datasheet-C'!G" & i & ") & """""
    Else
            Sheets("Accredited").Range("G" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("G" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("G" & i) = "=T('Datasheet-C'!G" & i & ")"
    End If
    If IsNumeric(Sheets("Datasheet-C").Range("H" & i)) = True Then
            Sheets("Accredited").Range("H" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("H" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("H" & i).Value = "=('Datasheet-C'!H" & i & ") & """""
    Else
            Sheets("Accredited").Range("H" & i).Borders.LineStyle = xlNone
            Sheets("Accredited").Range("H" & i).Interior.Color = xlNone
            Sheets("Accredited").Range("H" & i) = "=T('Datasheet-C'!H" & i & ")"
    End If

         
    Next
 

End Sub


ArnMan said:
Hello,
I was wondering if it is possible to detect a merged cell or range on one sheet(Sheet1) and merge the same cells in another sheet(Sheet2)?
The columns being copied over go from B to H in a loop
I am copying them row by row until LastRow.

Not every cell in each B H range is going to be merged. Each row is going to be different.
Example B to C could be merged in 1 row
or B to E merged
or C to D merged or any combination.

Merging is the only formatting I want. I don't want interior colors and borders.
Is there a way to copy over the row in the loop
find which cells are merged Sheet1 and copy them over to the other sheet Sheet2? and retain values in whatever cells there are?

here is my code for copying

Code: 
Dim lRowAdd As Long
lRow = Sheets("Datasheet-C").Cells(Rows.Count, "AAA").End(xlUp).Row
lRowAdd = lRow
Dim i As Integer
    For i = 1 To lRowAdd
        
        Sheets("Datasheet-C").Range("AAA" & i).Value = 1
        
        Sheets("Accredited").Range("B" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("B" & i).Value = Sheets("Datasheet-C").Range("B" & i).Text
        Sheets("Accredited").Range("C" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("C" & i).Value = Sheets("Datasheet-C").Range("C" & i).Text
        Sheets("Accredited").Range("D" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("D" & i).Value = Sheets("Datasheet-C").Range("D" & i).Text
        Sheets("Accredited").Range("E" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("E" & i).Value = Sheets("Datasheet-C").Range("E" & i).Text
        Sheets("Accredited").Range("F" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("F" & i).Value = Sheets("Datasheet-C").Range("F" & i).Text
        Sheets("Accredited").Range("G" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("G" & i).Value = Sheets("Datasheet-C").Range("G" & i).Text
        Sheets("Accredited").Range("H" & i).HorizontalAlignment = xlCenter
        Sheets("Accredited").Range("H" & i).Value = Sheets("Datasheet-C").Range("H" & i).Text
         
    Next
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Applying VBA to other cells
Replies
2
Views
456
NoSparks
N
C
  • Solved
Transpose Data from one sheet to another
Replies
5
Views
323
awoohaw
awoohaw
R
  • Question Question
Macro not working after adding two new items
Replies
5
Views
426
regan_2000
R
E
  • Question Question
Estimating Spreadsheet-Summing
Replies
1
Views
339
Peter_SSs
Peter_SSs
J
  • Question Question
Automatically move cells from one sheet to another based on criteria using VBA
Replies
5
Views
707
DanteAmor
DanteAmor

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top