Customer Form Header and Logo to be copied RRS feed

  • Question

  • Hi,

    I have an existing VBA code on master file to create new work book and worksheets breakdown by master file column value

    But when i add the logo and report header the column split doesn't work in the new work book and i get the same master file information on each new tab.

    Please can some one help me to resolve this issue?

    Below is the code

    Sub CopyInNewWB()

    Dim wbO As Workbook, wbN As Workbook
    Dim xRCount As Long
    Dim xSht As Worksheet
    Dim xNSht As Worksheet
    Dim i As Long
    Dim xTRrow As Integer
    Dim xCol As New Collection
    Dim xTitle As String
    Dim xSUpdate As Boolean
    Dim xCName As Integer
    Dim xTA, xRA, xSRg1 As String
    Set xSht = ThisWorkbook.Worksheets("Template")
    On Error Resume Next

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    Set wbO = ActiveWorkbook
    Set wbN = Workbooks.Add
    Sheets("Template").Move After:=Workbooks("Book2").Sheets(3)
    xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row

    xTitle = "A1:K1"
    xCName = "2" 'Change this number to the column number which you will create new sheets based on
    xTRrow = xSht.Range(xTitle).Cells(1).Row
    For i = 2 To xRCount
    Call xCol.Add(xSht.Cells(i, xCName).Text, xSht.Cells(i, xCName).Text)
    xSUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xSRg = xSht.Cells(1, xCName).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    For i = 1 To xCol.Count
    Call xSht.Range(xTitle).AutoFilter(xCName, CStr(xCol.Item(i)))
    Set xNSht = Nothing
    Set xNSht = Worksheets(CStr(xCol.Item(i)))
    If xNSht Is Nothing Then
    Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
    xNSht.Name = CStr(xCol.Item(i))
    ActiveWindow.DisplayGridlines = False
    xNSht.Move , Sheets(Sheets.Count)

    End If
    xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
    With ActiveWorkbook
        For Each lnk In .LinkSources(Type:=xlLinkTypeExcelLinks)
         .BreakLink Name:=lnk, Type:=xlLinkTypeExcelLinks
    End With
    xSht.AutoFilterMode = False
    Application.ScreenUpdating = xSUpdate
    wbN.Sheets("Pack Name").Delete

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

    End Sub

    • Edited by Varun6666 Sunday, July 19, 2020 5:06 AM
    Sunday, July 19, 2020 5:05 AM

All replies

  • Have you tried using the macro recorder which allows recording the steps made manually and then generate the required VBA code? So, you will be able to understand what is wrong with your code or what part is missed.

    See Recording a Macro in Excel for more information.


    profile for Eugene Astafiev at Stack Overflow, Q&A for professional and enthusiast programmers

    Saturday, July 25, 2020 3:24 PM