17 thoughts on “Copy Data Paste another Workbook Transpose Automatically using Excel VBA”

1. How to copy data, paste it in another workbook while transposing the pasted data using VBA.
   Do you have the VBA code using Rows instead of columns
   https://www.exceltrainingvideos.com/copy-data-paste-another-workbook-transpose-automatically-using-excel-vba/

   1. Have a look at this link: https://www.exceltrainingvideos.com/copy-paste-multiple-rows-of-data-from-one-workbook-to-another-using-excel-vba/
      There are many more such examples using rows instead of columns.

      1. Sir… awesome tutorials THANKS 🙂

         Like Bill, I am also facing issues while transposing columns from one Workbook to rows in another Workbook. Tried your methodology but its ending with error 1004.
         Unfortunately, there is no help available online on transposing from horizontal to vertical from different workbooks. Can you pl guide ? It will be of great help to me and all.

   2. Sirji I work on cash collection counter need cash denomination control system by using Excel for avoid difference in cash with count transaction

2. Hello Sir
   Above code works great. but my data is in single column so whenever I use this code it transpose data in same row only, If want to Transpose like first eight cells of column in first row, Next eight cells in next row and so on. So please share the code for this.

3. how to open excel open password if we forgot. i lost my password excel open.(.xls – format)

4. Pingback: Copy Paste Data in Excel with VBA | Excel VBA Training Videos

5. dear sir
   thank you to every thing that you give us . i have question
   how can i copy that data in rows and what will we do if that cells have result from FX
   thank you

6. Dears ,

   I have a question regarding the VBA codes.
   I want to copy data “specific columns” from opened excel file (excel file is attachment in outlook – Name of the file in outlook attachment looks like: 20171011__GAMA_Programi i aprovuar.xlsx and changes everyday ) and to paste transpose them into another workbook on my PC.
   How can I do this automatically with VBA macro (codes) by one Button taking into account change of the file name everyday( (without changing manually the name of the attached file).
   I appreciate your help

   Thanks in advance.
   Best regards

7. Pingback: How to Copy Column Data into Another Workbook | Excel VBA Training Online

8. i have to copy a column(Column header = “contract#”) that is in another workbook and this workbook has multiple sheets. we have to check in every sheets of workbook.

9. Hello,

   I am trying to do the same thing but with rows and I get an error “Pastespecial method of range class failed” Everything works minus the paste, unless I open the second workbook and select a cell.

   ActiveSheet.Range(“LL_Data”).Copy

   Workbooks.Open Filename:=”C:\……x”
   ActiveSheet.Unprotect Password:=”Secret”
   erow = Sheets(“DiscoveredLessons”).Cells(Rows.Count, “A”).End(xlUp).Offset(0).Row
   If erow >= 1 Then erow = erow + 1
   ActiveSheet.Cells(erow, 1).Select
   Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
   ActiveSheet.Protect Password:=”Secret”
   ActiveWorkbook.Save
   ActiveWorkbook.Close
   ActiveSheet.Unprotect Password:=”190″
   Sheets(“Sheet1”).Range(“LL_Data”).ClearContents
   ActiveSheet.Protect Password:=”190″
   ActiveWorkbook.Save

10. This is to format a xlsm workbook, creat xlxs workbooks and email them.

    Option Explicit

    Sub Macro1()
    Call formatWorkSheet
    Call SaveAsString
    End Sub

    Sub Macro2()
    Call DeleteColumns
    ‘ Call SendEmails
    Call del_xlsxFiles
    Call deleteColNthiswb
    End Sub

    ‘1. format the worksheet and insert data in columns N and O
    Sub formatWorkSheet()
    Dim i As Integer
    Dim lRow As Integer
    lRow = Sheets(“Sheet1”).Range(“A” & Rows.Count).End(xlUp).Row
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Columns(“J:N”).Select
    Selection.Delete Shift:=xlToLeft
    Range(“J1”).Select
    ActiveCell.FormulaR1C1 = “REG or ORP”
    Range(“K1”).Select
    ActiveCell.FormulaR1C1 = “C C Code”
    Range(“L1”).Select
    ActiveCell.FormulaR1C1 = “Discharging?”
    Range(“M1”).Select
    ActiveCell.FormulaR1C1 = “Disch Date”
    Range(“N1”).Select
    ActiveCell.FormulaR1C1 = “Save As”
    Range(“O1”).Select
    ActiveCell.FormulaR1C1 = “Email Address”
    Range(“J2”).Select

    Rows(“1:1”).Select
    Selection.Font.Bold = True
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With

    For i = 2 To lRow
    Range(“N” & i).Select
    ActiveCell.FormulaR1C1 = “=TEXT(RC[-8], “”YYYYMMDD””) & “” LPA “” & RC[-12] & “”, “” & RC[-11] & “” “”& RC[-13]”
    Range(“N” & i + 1).Select
    Next i

    For i = 2 To lRow
    Range(“O” & i).Select
    ActiveCell.FormulaR1C1 = “[email protected]”
    Range(“O” & i + 1).Select
    Next i

    Cells.Select
    Selection.Columns.AutoFit
    Range(“A1”).Select
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End Sub

    ‘2. Create files
    Sub SaveAsString()
    Dim i As Integer
    Dim lRow As Integer
    Dim sPath As String
    Dim sFileName As String
    Dim oFilename As String
    oFilename = “zMaster” ‘ Change “Book1” to the name of the original workbook
    sPath = ThisWorkbook.Path
    lRow = Sheets(“Sheet1”).Range(“A” & Rows.Count).End(xlUp).Row

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    For i = 2 To lRow

    Range(“A” & i & “:” & “M” & i).Select
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
    End With

    sFileName = Range(“N” & i).Value
    ActiveWorkbook.SaveAs fileName:=sPath & “\” & sFileName & “.xlsx”, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    Range(“A” & i & “:” & “M” & lRow).Select
    With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
    End With

    Next i

    Workbooks.Open fileName:=sPath & “\” & oFilename & “.xlsm”
    Workbooks.Open fileName:=sPath & “\” & sFileName & “.xlsx”
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
    End Sub
    ‘3. Delete columns in all the files created
    Sub DeleteColumns()

    Dim wbOpen As Workbook
    Dim MyDir As String
    MyDir = ActiveWorkbook.Path ‘ current path
    Dim strExtension As String

    strExtension = Dir(MyDir & “\*.xlsx”)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    While strExtension vbNullString
    Set wbOpen = Workbooks.Open(MyDir & “\” & strExtension)

    Call deleteColN

    strExtension = Dir
    Wend
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    End Sub

    Sub deleteColN()
    Columns(“N:O”).Select
    Selection.Delete Shift:=xlToLeft
    Range(“A1″).Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End Sub

    ‘4. Send Emails.
    ‘https://www.youtube.com/watch?v=0k8t2Fy6nSc
    Sub SendEmails()
    Dim EmailAddress As String
    Dim SubjectString As String
    Dim MessageString As String
    Dim sFileName As String
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim MyAttachments As Object
    Dim sPath As String
    Dim LastRow As Integer
    Dim Attachment As String
    Dim x As Integer

    x = 2
    Do While Sheet1.Cells(x, 1) ” ”

    Set OutLookApp = CreateObject(“Outlook.Application”)
    Set OutLookMailItem = OutLookApp.CreateItem(0)
    Set MyAttachments = OutLookMailItem.attachmets
    sPath = ActiveWorkbook.Path & “\”

    EmailAddress = Sheet1.Cells(x, 15)
    SubjectString = Sheet1.Cells(x, 14) & ” [SEC=CLASSIFIED]”
    sFileName = Sheet1.Cells(x, 14) & “.xlsx”
    Attachment = sPath + sFileName

    MsgBox EmailAddress
    OutLookMailItem.To = EmailAddress
    OutLookMailItem.Subject = SubjectString
    OutLookMailItem.Body = “Please finD LPA for this fortnight” & vbCrLf & “Regards ” & vbCrLf & “Raghu Prabhu”
    MyAttachments.Add (Attachment)
    OutLookMailItem.Display
    OutLookMailItem.Send
    LastRow = LastRow + 1
    EmailAddress = “”
    x = x + 1
    Loop
    Set OutLookApp = Nothing
    Set OutLookMailItem = Nothing

    End Sub
    ‘5. Delete all the files created and emailed
    Sub del_xlsxFiles()
    Dim sPath As String
    sPath = ThisWorkbook.Path
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Kill sPath & “\*.xlsx”
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    End Sub

    ‘6. delete column N and O in this worksheet
    Sub deleteColNthiswb()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Columns(“N:O”).Select
    Selection.Delete Shift:=xlToLeft
    Range(“A1”).Select
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End Sub

11. Dim mess_body As String, StrFile As String, StrPath As String
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem

    Set appOutLook = CreateObject(“Outlook.Application”)
    Set MailOutLook = appOutLook.CreateItem(olMailItem)

    ‘~~> Change path here
    StrPath = “H:\test\”

    With MailOutLook
    .BodyFormat = olFormatRichText
    .To = “[email protected]”
    .Subject = “test”
    .HTMLBody = “test”

    ‘~~> *.* for all files
    StrFile = Dir(StrPath & “*.*”)

    Do While Len(StrFile) > 0
    .Attachments.Add StrPath & StrFile
    StrFile = Dir
    Loop

    ‘.DeleteAfterSubmit = True
    .Send
    End With

    MsgBox “Reports have been sent”, vbOKOnly

12. How to formula paste as value in this forma whic is i add below show debug plsease help me to make this thanks.
    ActiveSheet.Range(“A2:F4″).Copy
    Workbooks.Open Filename:=”C:\Users\suresh M\Desktop\copied-employee-data.xlsx”
    eColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    If eColumn >= 1 Then eColumn = eColumn + 1
    ActiveSheet.Cells(1, eColumn).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Skipblanks:=False, Transpose:=True
    Selection.PasteSpecial xlPasteValues
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Application.CutCopyMode = False

13. How to formula paste as value in this format which is i add below show debug please help me to how can use in value this thanks.
    ActiveSheet.Range(“A2:F4″).Copy
    Workbooks.Open Filename:=”C:\Users\suresh M\Desktop\copied-employee-data.xlsx”
    eColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    If eColumn >= 1 Then eColumn = eColumn + 1
    ActiveSheet.Cells(1, eColumn).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Skipblanks:=False, Transpose:=True
    Selection.PasteSpecial xlPasteValues
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Application.CutCopyMode = False

14. how to transpose column data to row but in another workbook? can you plz give me the code for it. thanks

Comments are closed.