Adding Column to the Next Empty Column in a Worksheet while Maintaining Formatting

[aryaden]

I am currently using the code below to insert a column near the last occupied cell.

VBA Code:
Sub xx()
Dim LastRow As Long
Dim LastCol As Long
Dim iRow As Long
Set ws = Sheet1 ' Data is in Sheet1.

With ws
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

.Cells(1, LastCol + 1).Value = "New Column Title"
End With
End Sub

Currently the output of this is (using example data)

Example Sheet.xlsm
	A	B	C	D	E	F	G	H
1	Description	Monday	Tuesday	Wednesday	Thursday	Friday	Saturday	New Column Title
2		1	1	1	1	1	1
3	AAAA	X		X
4	BBBB		X		X		X
5	CCCC		X	X
6	DDDD	X			X	X	X
7	EEEE			X			X
8	FFFF		X		X	X	X
9	GGGG		X	X
10
Sheet1

I would like the output to be

Example Sheet.xlsm
	A	B	C	D	E	F	G	H
1	Description	Monday	Tuesday	Wednesday	Thursday	Friday	Saturday	New Column Title
2		1	1	1	1	1	1
3	AAAA	X		X
4	BBBB		X		X		X
5	CCCC		X	X
6	DDDD	X			X	X	X
7	EEEE			X			X
8	FFFF		X		X	X	X
9	GGGG		X	X
10
11
Sheet1 (3)

Is there anyway to edit my code to achieve this?

 

[Osvaldo Palmeiro]

Try:

Sub xxV2()
 Dim LastCol As Long
  With Sheet1
   LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
   .Cells(1, LastCol + 1) = "New Column Title"
   .Columns(LastCol).Copy
   .Columns(LastCol + 1).PasteSpecial xlFormats
  End With
End Sub

 

[aryaden]

Try:

Sub xxV2()
 Dim LastCol As Long
  With Sheet1
   LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
   .Cells(1, LastCol + 1) = "New Column Title"
   .Columns(LastCol).Copy
   .Columns(LastCol + 1).PasteSpecial xlFormats
  End With
End Sub

Thank you so much, that worked for me! Do you know if there is a way to merge cells E1 and F1 (in this example) using the LastCol + 1 and LastCol +2 reference instead of E1 and F1?

Example would look like this:

Example Sheet.xlsm
	A	B	C	D	E	F	G	H	I
1	Description	Monday	Monday	Tuesday	New Column
2		1	2	1	1	2
3	AAAA	X	X
4	BBBB		X	X
5	CCCC			X
6	DDDD	X	X
7	EEEE		X
8	FFFF			X
9	GGGG			X
10
11
Sheet1

 

[Osvaldo Palmeiro]

Please, try this modified one.

Sub xxV3()
 Dim LastCol As Long, k As Long
  Application.ScreenUpdating = False
  With Sheet1
   LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
   k = IIf(.Cells(1, LastCol).MergeCells, 2, 1)
   .Columns(LastCol).Resize(, k).Copy
   .Columns(LastCol + k).Resize(, 2).PasteSpecial xlFormats
   With .Cells(LastCol + k).Resize(, 2)
    .Merge
    .HorizontalAlignment = xlCenter
    .Value = "New Column Title"
    .Select
   End With
  End With
End Sub

 

[aryaden]

Please, try this modified one.

Sub xxV3()
 Dim LastCol As Long, k As Long
  Application.ScreenUpdating = False
  With Sheet1
   LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
   k = IIf(.Cells(1, LastCol).MergeCells, 2, 1)
   .Columns(LastCol).Resize(, k).Copy
   .Columns(LastCol + k).Resize(, 2).PasteSpecial xlFormats
   With .Cells(LastCol + k).Resize(, 2)
    .Merge
    .HorizontalAlignment = xlCenter
    .Value = "New Column Title"
    .Select
   End With
  End With
End Sub

Thank you! That worked