Copying a table to new worksheet after it has been sorted from a previous worksheet

S

Shizo

New Member
Joined
Jan 5, 2025
Messages
17
Office Version
  1. 2016
Platform
  1. Windows
Hello,
I have a table of a course schedule on worksheet 1 (Schedule By Date). I have a macro that copies the table and pastes it into a new sheet worksheet (Schedule by LD) the macro then sorts the table based on LD #, then by date. If I make any changes to the source table, it adds those changes correctly to the destination page. I am trying to copy and paste the newly sorted table from (Schedule by LD) to another worksheet (LD By Day). Everything is working fine up to this point but when I try to dynamically copy and paste the sorted table to (LD By Day) I run into a "paste method of worksheet class failed" error and any changes to the sorted table do not automatically transfer to the (LD By Day) worksheet. Here is the macro. Can you help me figure out why this is happening?

Sub TransferSortedTable()
'
' TransferSortedTable Macro
' transfer sorted table from schedule by LD to LD by Day

Sheets("Schedule by LD").Select
Range("Table14[#All]").Select
Selection.Copy
Sheets("LD By Day").Select
Sheets("LD By Day").Activate
ActiveSheet.Range("A2").Select
Application.CutCopyMode = False
Sheets("LD By Day").Paste
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
End Sub

I will need help with a SUM macro as well once this is figured out.
Thank you for any assistance you may be able to provide!
 
Sort by date Sort by votes
OK, in sheet "Schedule by Date" cell E3 paste the following formula : ='Schedule by LD'!E3

Drag that formula down the column as far as you need to for future entries made in sheet "Schedule by LD"

Be certain the column E in both sheets is formatted as NUMBER with 2 decimal spaces.
 
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Logit said:
OK, in sheet "Schedule by Date" cell E3 paste the following formula : ='Schedule by LD'!E3

Drag that formula down the column as far as you need to for future entries made in sheet "Schedule by LD"

Be certain the column E in both sheets is formatted as NUMBER with 2 decimal spaces.
Click to expand...
I will try this in the morning and let you know how it goes…. Thank you again!!!
 
Upvote 0
That does not work unfortunately. I am able to put in a number in Column E on Schedule by LD but with this formula it puts that value in a bunch of other cells in Column E on the same page and Column E on the Schedule by Date page....
 
Upvote 0
Try changing this line of code : "Sheets("LD By Day").Paste" to this : Sheets("LD By Day").Range("A1").PasteSpecial Paste:=xlPasteValues
 
Upvote 0
That did not work either......

Ok, maybe this will work. I have created a new table on Schedule by LD (which is a copy of Column E just set aside as its own table). Since Schedule by LD is a sorted copy of Schedule by Date, every time something is entered it changes Schedule by LD. Can I copy the sorted table of Schedule by LD and the new Column E table and have them merge into a new table on worksheet LD By Day with the Column E table replacing the blank Column E in Schedule by LD table?
 
Upvote 0
Here ya go. Tested and working here.

VBA Code: 
Option Explicit

Sub TransferAndSortTable()
    On Error GoTo ErrorHandler

    Dim lastTable As ListObject
    Dim lastTableName As String
    Dim maxTableNum As Long
    Dim tableNum As Long
    Dim tableName As String
    Dim tableLD As ListObject
    Dim wsLD As Worksheet
    Dim wsLDbyDay As Worksheet
    Dim colIndex As Long
    Dim col As Variant

    ' Check if the "Schedule by Date" sheet exists
    If Not SheetExists("Schedule by Date") Then
        MsgBox "The sheet 'Schedule by Date' does not exist.", vbExclamation
        Exit Sub
    End If

    ' Check if the "Schedule by LD" sheet exists
    If Not SheetExists("Schedule by LD") Then
        MsgBox "The sheet 'Schedule by LD' does not exist.", vbExclamation
        Exit Sub
    End If

    ' Check if the "LD by Day" sheet exists
    If Not SheetExists("LD by Day") Then
        MsgBox "The sheet 'LD by Day' does not exist.", vbExclamation
        Exit Sub
    End If

    ' Set worksheet references
    Set wsLD = Sheets("Schedule by LD")
    Set wsLDbyDay = Sheets("LD by Day")

    ' Copy Table1 from "Schedule by Date" to "Schedule by LD"
    Sheets("Schedule by Date").ListObjects("Table1").Range.Copy
    wsLD.Range("A1").PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    Sheets("Schedule by LD").Columns("A:I").EntireColumn.AutoFit

    ' Find the latest table name in "Schedule by LD"
    maxTableNum = 0

    For Each tableLD In wsLD.ListObjects
        tableName = tableLD.Name
        If Left(tableName, 5) = "Table" Then
            tableNum = CLng(Mid(tableName, 6))
            If tableNum > maxTableNum Then
                maxTableNum = tableNum
                lastTableName = tableName
            End If
        End If
    Next tableLD

    If lastTableName = "" Then
        MsgBox "No table found in 'Schedule by LD'.", vbExclamation
        Exit Sub
    End If

    ' Check if "LD #" column exists in the latest table
    Dim colFound As Boolean
    colFound = False
    For Each col In wsLD.ListObjects(lastTableName).ListColumns
        If col.Name = "LD" Then
            colIndex = col.Index
            colFound = True
            Exit For
        End If
    Next col

    If Not colFound Then
        MsgBox "The column 'LD' does not exist in the table '" & lastTableName & "'.", vbExclamation
        Exit Sub
    End If

    ' Sort the data in "Schedule by LD" by LD # (column D)
    With wsLD.ListObjects(lastTableName).Sort
        .SortFields.Clear
        .SortFields.Add Key:=wsLD.ListObjects(lastTableName).ListColumns(colIndex).Range, _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:=xlSortNormal
        .Header = xlYes
        .Apply
    End With

    ' Copy the sorted data to "LD by Day"
    wsLD.ListObjects(lastTableName).Range.Copy
    wsLDbyDay.Range("A1").PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False

    ' Autofit columns in "LD by Day"
    With wsLDbyDay
        .Columns("A:I").EntireColumn.AutoFit
    End With

    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbExclamation
End Sub

' Function to check if a sheet exists
Function SheetExists(sheetName As String) As Boolean
    On Error Resume Next
    SheetExists = Not Worksheets(sheetName) Is Nothing
    On Error GoTo 0
End Function
 
Upvote 0
That did not work for me unfortunately. It added values in different places and the sorting was all mixed up..... I now have a sorted table which works. I have a new table to the side. I want to combine the two tables and replace the values in Column E with the new table column N I created and want it to update dynamically when I put values into the new column N table
1736455828969.png

The goal is to have this new combined table on LD By Day worksheet. Pic above should show you what I am hoping to accomplish.
 
Upvote 0
Hello,
I tried the copy values you mentioned in another thread and it did not work......

This is what I want to try to do....
I have the Source table on "Schedule by Date". The table is copied and pasted onto "Schedule by LD" where it is sorted. I have created a new table in Column N called "DataEntry" I want the Source table to lookup the value in DataEntry table given to the row in the sorted table on Schedule by LD and then input that value in the LD/DAY column in the associated row in the Source table and as I enter the values I want the data to update.

The goal is to end up with a schedule by date table with the LD/DAY values in the correct rows and then that will be copied/pasted/sorted into the table on schedule by LD so the LD/DAY values will be in order by LD

1736891642282.png
1736891719246.png


Schedule by Date (Source table) Schedule by LD (Copied/Pasted/Sorted table) DataEntry table
 
Upvote 0
This macro sorts the sheets as requested.

VBA Code: 
Option Explicit

Sub TransferAndSortTable()
    On Error GoTo ErrorHandler

    Dim lastTable As ListObject
    Dim lastTableName As String
    Dim maxTableNum As Long
    Dim tableNum As Long
    Dim tableName As String
    Dim tableLD As ListObject
    Dim wsLD As Worksheet
    Dim wsLDbyDay As Worksheet
    Dim colIndex As Long
    Dim col As Variant
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim cell As Range
    Dim targetCell As Range

    ' Check if the sheets exist
    If Not SheetExists("Schedule by Date") Then
        MsgBox "The sheet 'Schedule by Date' does not exist.", vbExclamation
        Exit Sub
    End If
    If Not SheetExists("Schedule by LD") Then
        MsgBox "The sheet 'Schedule by LD' does not exist.", vbExclamation
        Exit Sub
    End If
    If Not SheetExists("LD by Day") Then
        MsgBox "The sheet 'LD by Day' does not exist.", vbExclamation
        Exit Sub
    End If

    ' Set worksheet references
    Set wsLD = Sheets("Schedule by LD")
    Set wsLDbyDay = Sheets("LD by Day")

    ' Copy Table1 from "Schedule by Date" to "Schedule by LD"
    Sheets("Schedule by Date").ListObjects("Table1").Range.Copy
    wsLD.Range("A1").PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    wsLD.Columns("A:I").EntireColumn.AutoFit

    ' Find the latest table in "Schedule by LD"
    maxTableNum = 0
    For Each tableLD In wsLD.ListObjects
        tableName = tableLD.Name
        If Left(tableName, 5) = "Table" Then
            tableNum = CLng(Mid(tableName, 6))
            If tableNum > maxTableNum Then
                maxTableNum = tableNum
                lastTableName = tableName
            End If
        End If
    Next tableLD

    If lastTableName = "" Then
        MsgBox "No table found in 'Schedule by LD'.", vbExclamation
        Exit Sub
    End If

    ' Verify "LD" column exists in the latest table
    Dim colFound As Boolean
    colFound = False
    For Each col In wsLD.ListObjects(lastTableName).ListColumns
        If col.Name = "LD" Then
            colIndex = col.Index
            colFound = True
            Exit For
        End If
    Next col

    If Not colFound Then
        MsgBox "The column 'LD' does not exist in the table '" & lastTableName & "'.", vbExclamation
        Exit Sub
    End If
    
    Dim lastRow As Long

    ' Ensure column D in "Schedule by LD" is treated as numeric
    lastRow = wsLD.Cells(wsLD.Rows.Count, "D").End(xlUp).Row
    wsLD.Range("D2:D" & lastRow).NumberFormat = "General"
    wsLD.Range("D2:D" & lastRow).Value = wsLD.Range("D2:D" & lastRow).Value ' Force conversion to numbers

    ' Sort column D in "Schedule by LD"
    With wsLD.Sort
        .SortFields.Clear
        .SortFields.Add Key:=wsLD.Range("D2:D" & lastRow), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:=xlSortNormal
        .SetRange wsLD.Range("A1:I" & lastRow) ' Include full table
        .Header = xlYes
        .Apply
    End With

    ' Copy the data to "LD by Day"
    Set sourceRange = wsLD.ListObjects(lastTableName).Range
    Set targetRange = wsLDbyDay.Range("A1").Resize(sourceRange.Rows.Count, sourceRange.Columns.Count)

    ' Copy values
    targetRange.Value = sourceRange.Value

    ' Ensure column D in "LD by Day" is treated as numeric
    lastRow = wsLDbyDay.Cells(wsLDbyDay.Rows.Count, "D").End(xlUp).Row
    wsLDbyDay.Range("D2:D" & lastRow).NumberFormat = "General"
    wsLDbyDay.Range("D2:D" & lastRow).Value = wsLDbyDay.Range("D2:D" & lastRow).Value ' Force conversion to numbers

    ' Sort column D in "LD by Day"
    With wsLDbyDay.Sort
        .SortFields.Clear
        .SortFields.Add Key:=wsLDbyDay.Range("D2:D" & lastRow), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:=xlSortNormal
        .SetRange wsLDbyDay.Range("A1:I" & lastRow) ' Include full table
        .Header = xlYes
        .Apply
    End With

    ' Copy formats manually
    For Each cell In sourceRange
        Set targetCell = targetRange.Cells(cell.Row - sourceRange.Row + 1, cell.Column - sourceRange.Column + 1)
        With targetCell
            .Font.Color = cell.Font.Color ' Copy text color
            .Font.Bold = cell.Font.Bold ' Copy bold property
            .Borders.LineStyle = cell.Borders.LineStyle ' Copy border styles
        End With
    Next cell

    ' Autofit columns in "LD by Day"
    wsLDbyDay.Columns("A:I").EntireColumn.AutoFit

    ColorCells
    On Error Resume Next
    SelectCellA1InSheets

    Exit Sub

ErrorHandler:
    Debug.Print "Last row: " & lastRow
    MsgBox "An error occurred: " & Err.Description, vbExclamation
End Sub

' Function to check if a sheet exists
Function SheetExists(sheetName As String) As Boolean
    On Error Resume Next
    SheetExists = Not Worksheets(sheetName) Is Nothing
    On Error GoTo 0
End Function

Sub ColorCells()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("LD by Day") ' Change "Sheet1" to your actual sheet name
    Dim cell As Range

    For Each cell In ws.Range("D1:D" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row)
        Select Case cell.Value
            Case 0
                cell.Interior.Color = RGB(0, 0, 255) ' Blue
                cell.Offset(0, 2).Interior.Color = RGB(0, 0, 255) ' Blue
            Case 18
                cell.Interior.Color = RGB(165, 42, 42) ' Brown
                cell.Offset(0, 2).Interior.Color = RGB(165, 42, 42) ' Brown
            Case 31
                cell.Interior.Color = RGB(255, 192, 203) ' Pink
                cell.Offset(0, 2).Interior.Color = RGB(255, 192, 203) ' Pink
            Case 32
                cell.Interior.Color = RGB(0, 128, 0) ' Green
                cell.Offset(0, 2).Interior.Color = RGB(0, 128, 0) ' Green
            Case 33
                cell.Interior.Color = RGB(128, 0, 128) ' Purple
                cell.Offset(0, 2).Interior.Color = RGB(128, 0, 128) ' Purple
            Case 34
                cell.Interior.Color = RGB(255, 0, 0) ' Red
                cell.Offset(0, 2).Interior.Color = RGB(255, 0, 0) ' Red
            Case 97
                cell.Interior.Color = RGB(255, 255, 0) ' Yellow
                cell.Offset(0, 2).Interior.Color = RGB(255, 255, 0) ' Yellow
            Case 99
                cell.Interior.Color = RGB(173, 216, 230) ' Light Blue
                cell.Offset(0, 2).Interior.Color = RGB(173, 216, 230) ' Light Blue
            Case "TH"
                cell.Interior.Color = RGB(211, 211, 211) ' Light Grey
                cell.Offset(0, 2).Interior.Color = RGB(211, 211, 211) ' Light Grey
            Case "T"
                cell.Interior.Color = RGB(128, 128, 128) ' Grey
                cell.Offset(0, 2).Interior.Color = RGB(128, 128, 128) ' Grey
        End Select
    Next cell
End Sub

Sub SelectCellA1InSheets()
    Dim ws As Worksheet
    Dim sheetsArray As Variant
    On Error Resume Next
    ' Array of sheet names
    sheetsArray = Array("Schedule by Date", "Schedule by LD", "LD by Day")

    ' Loop through each sheet name in the array
    For Each ws In ThisWorkbook.Sheets(sheetsArray)
        ws.Activate
        ws.Range("A1").Select
    Next ws
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Deleting rows from a Range variable
Replies
4
Views
422
Umma123
U
D
  • Solved
Run-time error 9, Subscript out of range - Copying sheet from closed workbook to active workbook as new sheet
Replies
9
Views
585
dvward
D
A
  • Solved
Extract and Merge Files
Replies
1
Views
171
rowebca
rowebca
N
  • Solved
Command buttons not sorting - and sometimes jumping around on sort
2
Replies
10
Views
246
netxtown
N
B
  • Question Question
Excel VBA Searching Unique Variables to Match against Exported Schedule Files to Determine Date
Replies
1
Views
486
sijpie
sijpie

Forum statistics

Threads
1,225,482
Messages
6,185,253
Members
453,283
Latest member
Shortm88

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top