none
Copying data from one sheet to another RRS feed

  • Question

  • I have an Excel spreadsheet with two sheets. What the user would like to have done is to have some of the data copied or transposed from the second sheet to the main sheet. The trick is, some of the user data spans multiple rows but uses one column for each attribute.

    For example below is the 2nd sheet where the data is being copied/transposed from. The user would like columns F,G,H, and I copied to the main sheet.

    However some students have multiple rows and the FGHI columns have different values depending on the row.


    Below is the main sheet where I've manually copy/pasted the information from the ID # 88 student in the first screenshot to the row with the data. In the main sheet, the user wants to put columns FGHI into their own separate columns based on the row. Since the ID # 88 user covered two rows, the data spans horizontally through two sets of those same 4 columns (FGHI from the other sheet).


    And so, for instance, if a student's data covered three rows in the other sheet, the user would want the third rows data to be place in another set of 4 columns on the main sheet (status, start data, end date, description) Starting with column AE for "Math Status 3".

    Is there any way to transpose or copy this data automatically through the use of a rule or formula or macro of some kind? If there were only 50 rows I could do it manually, but this sheet where the data is being pulled from is over 700 rows.

    Our district has Office 365 support so I contacted Microsoft and they don't troubleshoot Excel client use issues and advised I either post in a forum or contact paid support.

    Any help would be greatly appreciated.


    • Edited by JMiller123 Friday, April 28, 2017 3:02 PM
    Friday, April 28, 2017 1:28 PM

All replies

  • Hello JMiler,

    I developed the code below in Visual Studio few years ago. it still works for me. hopefully give you an idea

    Public Class ModifyExcelFile
        Dim xlApp As Excel.Application
        Dim xlWorkBook As Excel.Workbook
        Dim xlWorkSheet As Excel.Worksheet
        Dim xlRange As Excel.Range
    
        Dim FilePath_str As String
        Dim Sheet_str As String
        Dim WorkSheetIndex_int As Integer
        Dim NewName_str As String
    
        Dim Dcc_con_str As String
        Dim CnEVM_Obj As New SqlClient.SqlConnection
        Dim daEVM_Obj As New SqlClient.SqlDataAdapter
        Dim dsEVM_Obj As New DataSet
        Dim nIcondll As System.Windows.Forms.NotifyIcon
        Dim dbu As New dbUtility.MydbUtilities()
    
    
        Public Property Dcc_ConnString_ID()
            Get
                Return Dcc_con_str
            End Get
            Set(ByVal value)
                Dcc_con_str = value
            End Set
        End Property
    
        Public Property FilePath_ID()
            Get
                Return FilePath_str
            End Get
            Set(ByVal value)
                FilePath_str = value
            End Set
        End Property
        Public Property Sheet_ID()
            Get
                Return Sheet_str
            End Get
            Set(ByVal value)
                Sheet_str = value
            End Set
        End Property
        Public Property SheetIndex_ID()
            Get
                Return WorkSheetIndex_int
            End Get
            Set(ByVal value)
                WorkSheetIndex_int = value
            End Set
        End Property
        Public Property NewWorkSeetName()
            Get
                Return NewName_str
            End Get
            Set(ByVal value)
                NewName_str = value
            End Set
        End Property
        Private Sub OpenExcelFile()
            dbu.CheckExcellProcesses()
            xlApp = New Excel.ApplicationClass
            xlWorkBook = xlApp.Workbooks.Open(FilePath_ID)
        End Sub
        Private Sub OpenExcelFile(ByVal Sh As String)
            dbu.CheckExcellProcesses()
            xlApp = New Excel.ApplicationClass
            xlWorkBook = xlApp.Workbooks.Open(FilePath_ID)
            xlWorkSheet = xlWorkBook.Worksheets(Sh)
        End Sub
        Public Sub CreateNewSheet()
            If (FilePath_ID <> "") Then
                OpenExcelFile()
                xlWorkBook.Worksheets.Add(Missing.Value, Missing.Value, Missing.Value, Missing.Value)
                xlWorkBook.Save()
                xlWorkBook.Close()
                xlApp.Quit()
                xlWorkSheet = Nothing
                xlWorkBook = Nothing
                xlApp = Nothing
                dbu.KillXl()
            Else
                Windows.Forms.MessageBox.Show("Please Set File Path Property first", "Check File Path")
            End If
        End Sub
        Public Sub CopyAsNewFile()
            If (FilePath_ID <> "") Then
                Dim TheF As New FileInfo(FilePath_ID)
                OpenExcelFile(Sheet_ID)
                'xlWorkSheet.Copy(Missing.Value, Missing.Value)
                xlWorkBook.Worksheets.Copy(Missing.Value, Missing.Value)
    
                '            xlWorkBook.SaveAs("C:\Copy of " + TheF.Name,Excel.xl
                xlWorkBook.Close()
                xlApp.Quit()
                xlWorkSheet = Nothing
                xlWorkBook = Nothing
                xlApp = Nothing
                dbu.KillXl()
            Else
                Windows.Forms.MessageBox.Show("Please Set File Path Property first", "Check File Path")
            End If
        End Sub
        Public Sub CopyDatainNewSheet()
            OpenExcelFile(Sheet_ID)
            'xlWorkBook.Worksheets.Copy(After:=xlWorkBook.Worksheets(xlWorkBook.Worksheets.Count))
            xlWorkBook.Worksheets(SheetIndex_ID).Copy(Before:=xlWorkBook.Worksheets(1))
    
            xlWorkBook.Worksheets(1).Name = NewWorkSeetName
            xlWorkBook.Save()
            xlWorkBook.Close()
            xlApp.Quit()
            xlWorkSheet = Nothing
            xlWorkBook = Nothing
            xlApp = Nothing
            dbu.KillXl()
        End Sub
    End Class



    • Edited by Alex_0s Friday, April 28, 2017 2:38 PM
    Friday, April 28, 2017 2:35 PM
  • I was sent the following macro and it works for the most part but some rows of data don't transfer over correctly. Some are blank on the main sheet and others are duplicated over and over.

    Sub Transpose()
    Dim i As Long, j As Long, k As Long, l As Long
    Dim arrData As Variant
    Dim lngID As Long
    arrData = Sheets("Intv").Range("A1").CurrentRegion.Value
    For i = 2 To UBound(arrData, 1)
        lngID = arrData(i, 1)
        With Sheets("All Schls").Range("A1")
            For j = 1 To .CurrentRegion.Rows.Count - 1
                If .Offset(j, 0) = lngID Then
                    l = 0
    Repeat:
                    For k = 0 To 3
                        .Offset(j, 22 + k + l) = arrData(i, 6 + k)
                    Next k
                    If i < UBound(arrData, 1) Then
                        If arrData(i + 1, 1) = lngID Then
                            i = i + 1
                            l = l + 4
                            GoTo Repeat
                        End If
                    End If
                    Exit For
                End If
            Next j
        End With
    Next i
    End Sub 

    Monday, May 1, 2017 2:04 PM
  • I was playing around with it some more and by sorting the sheets by Student ID it seemed to help. Feel free to close this thread.
    Monday, May 1, 2017 3:18 PM
  • Hi JMiller123,

    you had mentioned that,"I was playing around with it some more and by sorting the sheets by Student ID it seemed to help. Feel free to close this thread."

    if you want to close this thread then you need to mark the answer. then we can close this thread.

    if you do not mark answer then thread will remain open.

    so if you do not want any further suggestion then you can mark your second last post which have code.

    if you want any further suggestion then try to post your Excel file with dummy data and we can try to test the code above with that file.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Tuesday, May 2, 2017 6:49 AM
    Moderator