asked on

TT Add Column

I had this question after viewing TT Add Columns.

Hi Experts,

Need help with macro which add header to existing sheet.
in attached there is sheet called "Import" - i need to module which add column header from last available row. headers are mention in sheet setting range A2:A22.....see sheet 1 header - i am looking for that kind of output....

See attached
-TT-WIP.xlsm

Rgonzo1971

Hi,

pls try

    Set sh = Sheets("Setting")

    Range(sh.Range("A2"), sh.Range("A2").End(xlDown)).Copy
    Sheets("Import").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Rows("A:XFD").EntireColumn.AutoFit

Open in new window

Regards

Rgonzo1971

then maybe

Sub SplitImportData()
    Dim strPath As String
    Dim wsImport As Worksheet
    strPath = "D:\WIP Historicals"

    Set wsImport = ThisWorkbook.Worksheets("Import")
    
    wsImport.Select
    If wsImport.Range("A1") = "" Then
        wsImport.Rows("1:2").Delete
        wsImport.Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 4), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 4), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 4), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 4), Array( _
        33, 4), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 4), Array(38, 1), Array(39, 1), _
        Array(40, 4), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 4), Array(45, 1), Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
        Array(53, 1), Array(54, 1), Array(55, 1)), DecimalSeparator:=".", _
        ThousandsSeparator:=",", TrailingMinusNumbers:=True
        Set sh = Sheets("Setting")
        Range(sh.Range("A2"), sh.Range("A2").End(xlDown)).Copy
        Sheets("Import").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
    End If
    wsImport.Columns.AutoFit
    wsImport.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs strPath & "\" & Format(Date, "DD-MMM-YYYY") & ".xlsx"
    Application.DisplayAlerts = True
    ActiveWorkbook.Close False
End Sub

Open in new window

Naresh Patel

ASKER

Hi Experts,

Need help with macro which add header to existing sheet.
in attached there is sheet called "Import" - i need to module which add column header from last available row. headers are mention in sheet setting range A2:A22.....see sheet 1 header - i am looking for that kind of output....

See attached

For this required separate module.

Thanks

Rgonzo1971

then try

Sub Macro2()
    Set sh = Sheets("Setting")
    Range(sh.Range("A2"), sh.Range("A2").End(xlDown)).Copy
    ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveSheet.EntireColumn.AutoFit

End Sub

Open in new window

Naresh Patel

ASKER

Process Done with error ....with your code ...
i had added some lines by viewing other codes ...will you help me out to rectify where am i wrong ....i am not VBA expert so i am totally blank in this ...see code

Sub AddColumn()
    Dim wsImport As Worksheet
    Dim wsSetting As Worksheet

    Set wsSetting = ThisWorkbook.Worksheets("Setting")
    Set wsImport = ThisWorkbook.Worksheets("Import")
    
    wsSetting.Activate
    Range(wsSetting.Range("A2"), wsSetting.Range("A2").End(xlDown)).Copy
    wsImport.Activate
    wsImport.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    wsImport.EntireColumn.AutoFit
    Application.CutCopyMode = False

End Sub

Open in new window

Thanks

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Naresh Patel

ASKER

ok got it i had change line from