VBA copy worksheet and delete columns based on value

Sparky1983

New Member
Joined
Feb 19, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hi

I have the following code working so that it copies the “Template” tab and renames it based on a table in the summary tab

Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value: ActiveSheet.Range("G5") = c.Value
Next
End Sub

The "Template" has pre-populated information up to column GE but a lot of this can be deleted each time (e.g. the first tab may need all the info in the first 40 columns but second tab may only need the first 24 columns)

I have therefore included in column B on “Summary” the number of columns required for each tab created but I am unsure on how to include this in the above so that it automatically deletes the excess columns not required and to then adjust the print range to show F2:Lastcolum133.

Any help would be much appreciated.

Thanks!
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Can you use the XL2BB tool or make a screen shot to show us how the data in column B of Summary looks?
 
Upvote 0
Can you use the XL2BB tool or make a screen shot to show us how the data in column B of Summary looks?

Screen shot attached - column B is just a helper column I added which calculates the number of columns needed based on other information in the table (6+(I+J)*3)

1613821342171.png
 
Upvote 0
You used 'Delete' in your narrative, but this code only hides the columns from one iteration to the next in your loop. If the columns were deleted then you would have to organize your data with the maximum columns required to the minimum columns required. Try the procedure and see if it meets your needs.

VBA Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, lc As Long, col As Long
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
lc = sh2.Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
        col = c.Offset(, 1).Value + 2
        sh2.Cells(c.Row, col + 1).Resize(, lc - col).EntireColumn.Hidden = True
        sh1.Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = c.Value: ActiveSheet.Range("G5") = c.Value
        sh2.Columns.Hidden = False
    Next
End Sub
 
Upvote 0
You used 'Delete' in your narrative, but this code only hides the columns from one iteration to the next in your loop. If the columns were deleted then you would have to organize your data with the maximum columns required to the minimum columns required. Try the procedure and see if it meets your needs.

VBA Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, lc As Long, col As Long
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
lc = sh2.Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
        col = c.Offset(, 1).Value + 2
        sh2.Cells(c.Row, col + 1).Resize(, lc - col).EntireColumn.Hidden = True
        sh1.Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = c.Value: ActiveSheet.Range("G5") = c.Value
        sh2.Columns.Hidden = False
    Next
End Sub

Thanks for this - this seems to hide the columns on the summary page rather than on the renamed "Template" tab.

To summarise what I am trying to achieve:
Step 1: Currently the "Template" is copied and then renamed to Co A, Co B etc.
Step 2: Then delete columns 13 onwards on Co A tab and column 10 onwards on Co B using my example (based on your comment it appears this is not possible?)

As an alternative I could update the template tab if there a way to adapt the following so that is automatically copies and pastes as each template is created i.e. copy the template, rename to Co A and then copy columns K:M on Co A tab 12 times starting in column N, copy the template, rename to Co B and then copy columns K:M on Co B tab 9 times
VBA Code:
Sub Copycolumns()
Range("K:M").Copy Range("N1").Resize(, 3 * Range("G6").Value)
End Sub

or if the only option is to just hide the columns on Co A and Co B tabs then again I can amend the Template tab but would mean including additional formulae which I thought may cause the workbook to run slower when creating multiple sheets.

Thanks again for your help/advice.
 
Upvote 0
Can't test at the moment, but I think the below should work if you want to delete the columns (make sure you save it first before trying!!). I never like using activesheet after copying, but probably the best option.

VBA Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 as Worksheet, c As Range, lc As Long, col As Long
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
lc = sh2.Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
set sh3 = activesheet
with sh3
   .Name = c.Value
   .Range("G5") = c.Value
   col = c.Offset(, 1).Value + 2
   .Cells(c.Row, col + 1).Resize(, lc - col).EntireColumn.Delete
End With
Next
End Sub
 
Upvote 0
I was reading the OP wrongly. Do the numbers in column B of Summary start with column A of Template, or do they start with a different column?
 
Upvote 0
I think this is what you are looking for.

VBA Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, lc As Long
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value: ActiveSheet.Range("G5") = c.Value
With ActiveSheet
    lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    .Cells(1, c.Offset(, 1).Value + 1).Resize(, lc - c.Offset(, 1).Value).EntireColumn.Delete
    lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    .PageSetup.PrintArea = .Range("F2", .Cells(Rows.Count, 6).End(xlUp)).Resize(, lc - 5).Address
End With
Next
End Sub
 
Upvote 0
I think this is what you are looking for.

VBA Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, lc As Long
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value: ActiveSheet.Range("G5") = c.Value
With ActiveSheet
    lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    .Cells(1, c.Offset(, 1).Value + 1).Resize(, lc - c.Offset(, 1).Value).EntireColumn.Delete
    lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    .PageSetup.PrintArea = .Range("F2", .Cells(Rows.Count, 6).End(xlUp)).Resize(, lc - 5).Address
End With
Next
End Sub

Thanks, this worked well where the number of columns required was 15 or less but anything over 16 and it came up with a Run-time error '1004' with the following section highlighted:
.Cells(1, c.Offset(, 1).Value + 1).Resize(, lc - c.Offset(, 1).Value).EntireColumn.Delete
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,172
Members
448,554
Latest member
Gleisner2

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