• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Add Data in another sheet in Transpose mode

H

HKB

New Member
I have a little experience with VBA, and I would really appreciate any help with this issue.
In a basic sense, I need to ADD columns of data in sheet1 ("Nifty-50") in to rows of data in sheet2("Update Sheet") in Transposed.

Sample file attached here with.

what I enters data into a sheet ("Nifty-50") i.e Respective Date Column , and run Command button then copy data and add to another sheet ("Update Sheet") that has the same column headings, but transposed.
 

Attachments

  • Test File.xlsx
    17.8 KB · Views: 5
That's easy. Copy and transpose.

You can copy range, then right click on destination's top left cell.
Hit "s" twice, then hit "e" and hit ok.

Record this and you will get a starting point for your code.

Sample of what it looks like...
Code: 
Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("Nifty-50").Select
    Range("A2:L53").Select
    Selection.Copy
    Sheets("Update").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub

Now, since ".Select" will be unnecessary and range is fixed. Modify code...
Code: 
Sub CopyTranspose()

With Sheets("Nifty-50").Range("A2:L" & Sheets("Nifty-50").Cells(Rows.Count, "L").End(xlUp).Row)
    .Copy
End With

With Sheets("Update")
    .Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    .Columns.AutoFit
End With

Application.CutCopyMode = False

End Sub
 
Hi HKB,

This should get you started.
Code: 
Sub TransposeCopy()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
  
    'What sheet do you copy from/to?
    Set wsSource = Worksheets("Nifty-50")
    Set wsDest = Worksheets("Update")
  
    Application.ScreenUpdating = False
  
    'Clear old data
    wsDest.Cells.ClearContents
  
    With wsSource
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
      
        'Copy the data
        .Range("A2", .Cells(lastRow, lastCol)).Copy
      'Transpose it
        wsDest.Range("A2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
      
    End With
  'Clean-up
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
      
End Sub
 
Chihiro said:
That's easy. Copy and transpose.

You can copy range, then right click on destination's top left cell.
Hit "s" twice, then hit "e" and hit ok.

Record this and you will get a starting point for your code.

Sample of what it looks like...
Code: 
Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("Nifty-50").Select
    Range("A2:L53").Select
    Selection.Copy
    Sheets("Update").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub

Now, since ".Select" will be unnecessary and range is fixed. Modify code...
Code: 
Sub CopyTranspose()

With Sheets("Nifty-50").Range("A2:L" & Sheets("Nifty-50").Cells(Rows.Count, "L").End(xlUp).Row)
    .Copy
End With

With Sheets("Update")
    .Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    .Columns.AutoFit
End With

Application.CutCopyMode = False

End Sub
Click to expand...
Thanks Chihiro, your code works only range A:L but range A2:L not Fixed its day by day add.
 
Luke M said:
Hi HKB,

This should get you started.
Code: 
Sub TransposeCopy()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
 
    'What sheet do you copy from/to?
    Set wsSource = Worksheets("Nifty-50")
    Set wsDest = Worksheets("Update")
 
    Application.ScreenUpdating = False
 
    'Clear old data
    wsDest.Cells.ClearContents
 
    With wsSource
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
     
        'Copy the data
        .Range("A2", .Cells(lastRow, lastCol)).Copy
      'Transpose it
        wsDest.Range("A2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
     
    End With
  'Clean-up
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
     
End Sub
Click to expand...
Thanks Luke M..
Works perfect..will be back if any modification..
Thanks again..
 
Luke M said:
Hi HKB,

This should get you started.
Code: 
Sub TransposeCopy()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
 
    'What sheet do you copy from/to?
    Set wsSource = Worksheets("Nifty-50")
    Set wsDest = Worksheets("Update")
 
    Application.ScreenUpdating = False
 
    'Clear old data
    wsDest.Cells.ClearContents
 
    With wsSource
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
     
        'Copy the data
        .Range("A2", .Cells(lastRow, lastCol)).Copy
      'Transpose it
        wsDest.Range("A2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
     
    End With
  'Clean-up
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
     
End Sub
Click to expand...
Hi. Luke M
is it possible that my source sheet("Nifty-50") copy only column "F:F" and Add next empty row in my dest. sheet ("Update")?
so I can run daily once and update my Sheet on daily basis..
 
Yes...I'm assuming the layout would be different than your original file? Just thinking that in Test File, it looks like data is expanding to right. But, if you just want to keep copying col F to next blank row:

Code: 
Sub TransposeCopy()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    'What sheet do you copy from/to?
   Set wsSource = Worksheets("Nifty-50")
    Set wsDest = Worksheets("Update")
    Application.ScreenUpdating = False
'    'Clear old data
'   wsDest.Cells.ClearContents
    With wsSource
        lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
'        lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
     
        'Copy the data
       .Range("F2", .Cells(lastRow, "F")).Copy
      'Transpose it
    End With
    With wsDest
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial _
            Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
    End With
  'Clean-up
   Application.CutCopyMode = False
    Application.ScreenUpdating = True
     
End Sub
 
  • Like
Reactions: HKB
Luke M said:
Yes...I'm assuming the layout would be different than your original file? Just thinking that in Test File, it looks like data is expanding to right. But, if you just want to keep copying col F to next blank row:

Code: 
Sub TransposeCopy()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    'What sheet do you copy from/to?
   Set wsSource = Worksheets("Nifty-50")
    Set wsDest = Worksheets("Update")
    Application.ScreenUpdating = False
'    'Clear old data
'   wsDest.Cells.ClearContents
    With wsSource
        lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
'        lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    
        'Copy the data
       .Range("F2", .Cells(lastRow, "F")).Copy
      'Transpose it
    End With
    With wsDest
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial _
            Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
    End With
  'Clean-up
   Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub
Click to expand...
Thanks Luke M.
It's working..what I want...
 
You must log in or register to reply here.
Back
Top