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

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
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
Applying VBA to other cells
Replies
2
Views
219
NoSparks
N
R
  • Question
Macro not working after adding two new items
Replies
4
Views
162
myall_blues
myall_blues
E
  • Question
Estimating Spreadsheet-Summing
Replies
1
Views
179
Peter_SSs
Peter_SSs
E
  • Solved
Summing Values
Replies
3
Views
284
LazyBug
LazyBug
M
  • Solved
Do I have to repeat the same procedure to match combobox with two sheets and different columns
Replies
3
Views
99
dmt32
D

Forum statistics

Threads
1,216,030
Messages
6,128,405
Members
449,448
Latest member
Andrew Slatter

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