Transferring between workbooks

D

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,352
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have a complex spreadsheet that is used to generate a quote. The quote has information at the top: Caseworker, Organisation and Child/YP in 3 different cells. There is then a table under that called npss_quote. The table has rows relating to the information at the top.

The quotes then need to be copied to a another spreadsheet. This spreadsheet is called Costing tool. In Costing tool there is a table called tblCosting which contains more details regarding the quotes. The rows from npss_quote need to be copied below rows that exist in tblCosting. The information at the top of the quoting spreadsheet, Caseworker, Organisation and Child/YP needs to be the same for every row that gets copied across but the rows in npss_quote will have information that is specific to the individual row. The specific information for each row is Date, Service and Price.

I need code to be run from within the quoting spreadsheet to transfer the rows across to costing tool. I could work a lot of it out myself but I am not sure about copying the 3 cells at the top of the quoting spreadsheet to be the same for every row in npss_quote but then to have specific information regarding each row. The information that is specific to each row is Date, Service and Price.

So, every row that is copied from npss_quote to tblCosting will have the 3 cells at top of the quoting spreadsheet: Caseworker, Organisation and Child/YP, the same for each row. Every row in tblCosting will have a Date, Service and Price that is specific to each row in npss_quote.


The 3 cells at the top of the quoting spreadsheet that are to be copied for every row are:
  • Caseworker in B6
  • Organisation in B7
  • Child/YP in in a merged cell G6:H6

These need to be copied for each row that is copied from npss_quote to tblCosting. The cells in tblCosting that they need to go in are:
  • Caseworker needs to be put in column G
  • Organisation needs to be put in column F
  • Child/YP needs to be put in column D

The location of information that is specific to every row, Date, Service and Price is as follows:
  • Date is column A of npss_quote and needs to go in column A in tblCosting
  • Service is in column B of npss_quote and needs to go in column E in tblCosting
  • Price is in column H of npss_quote and needs to go in column H in tblCosting

The header row for npss_quote is in row 10 with data starting in row 11. The header row for tblCosting is in row 4 with the data starting in row 5.


I have tried to explain this but if it doesn't make sense, please reply to me and ask for clarification.




I would just like to say that this forum is the best,
I would really appreciate help with this,

Dave
 
Sort by date Sort by votes
I hope this helps:
Code: 
Option Explicit
Private Sub CmdSend_Click()
    Application.ScreenUpdating = False 'prevents screen flickering and speeds up the macro
    Application.EnableEvents = False 'prevents event macros from running which speeds up the macro and can avoid unwanted results or errors
    
    Dim desWS As Worksheet
    Dim srcWS As Worksheet
    
    Set srcWS = ThisWorkbook.Sheets("NPSS_quote_sheet") 'source worksheet
    Set desWS = ThisWorkbook.Sheets("Costing_tool") 'destination worksheet
    
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim x As Long
    Dim header As Range
    
    lastRow1 = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row
    lastRow2 = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    With srcWS.Range("A:A,B:B,H:H") 'columns to copy
        If lastRow2 < 5 Then 'checks if there is any data already copied in "Costing_tool" starting at row 5
            lastRow2 = 5 'if no data, sets last row to 5 and continues to next line of code, otherwise goes to 'Else' line of code
            For i = 1 To .Areas.Count 'loops through columns A, B and H
                x = .Areas(i).Column 'x represents the column number
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole) 'finds the header (row 10) in "Costing_tool"
                If Not header Is Nothing Then ' if found, executes next line of code
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy 'copies range starting in row 11 to lastrow in column
                    desWS.Cells(lastRow2, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 'pastes value to corresponding column in "Costing_tool"
                End If
            Next i
            With desWS
                If .Range("A" & .Rows.Count).End(xlUp).Row > 5 Then
                    desWS.ListObjects.Item("tblCosting").ListRows.Add 'inserts blank row with formulas
                End If
                'next 3 lines fill columns D, F and G in "Costing_tool"
                .Range("D" & lastRow2 & ":D" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("G7")
                .Range("F" & lastRow2 & ":F" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 & ":G" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("B6")
            End With
        Else 'if data already existed, executes next line of code; see above for explanatory comments
            lastRow2 = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            desWS.ListObjects.Item("tblCosting").ListRows.Add 'inserts blank row with formulas
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole)
                If Not header Is Nothing Then
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy
                    desWS.Cells(lastRow2 + 1, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            Next i
            With desWS
                .Range("D" & lastRow2 + 1 & ":D" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("G7")
                .Range("F" & lastRow2 + 1 & ":F" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 + 1 & ":G" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B6")
            End With
        End If
    End With
    
    'sorts data by 'Date' in "Costing_tool"
    desWS.ListObjects("tblCosting").Sort.SortFields.Clear
    desWS.ListObjects("tblCosting").Sort.SortFields. _
        Add Key:=desWS.Cells(, 1), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With desWS.ListObjects("tblCosting").Sort
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Application
        .CutCopyMode = False 'clears clipboard to unselect ranges copied for pasting
        .EnableEvents = True 'enables event macros
        .ScreenUpdating = True 'turns screen updating back on so you can see the changes made by the macro
    End With
End Sub
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
mumps said:
I hope this helps:
Code: 
Option Explicit
Private Sub CmdSend_Click()
    Application.ScreenUpdating = False 'prevents screen flickering and speeds up the macro
    Application.EnableEvents = False 'prevents event macros from running which speeds up the macro and can avoid unwanted results or errors
    
    Dim desWS As Worksheet
    Dim srcWS As Worksheet
    
    Set srcWS = ThisWorkbook.Sheets("NPSS_quote_sheet") 'source worksheet
    Set desWS = ThisWorkbook.Sheets("Costing_tool") 'destination worksheet
    
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim x As Long
    Dim header As Range [SIZE=3][U][I][B]Can you explain this line of code with a comment please?[/B][/I][/U][/SIZE]
    
    lastRow1 = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row [SIZE=3][U][I][B]Can you explain this line of code with a comment please?[/B][/I][/U][/SIZE]
    lastRow2 = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row [SIZE=3][U][I][B]Can you explain this line of code with a comment please?[/B][/I][/U][/SIZE]
    
    With srcWS.Range("A:A,B:B,H:H") 'columns to copy
        If lastRow2 < 5 Then 'checks if there is any data already copied in "Costing_tool" starting at row 5
            lastRow2 = 5 'if no data, sets last row to 5 and continues to next line of code, otherwise goes to 'Else' line of code
            For i = 1 To .Areas.Count 'loops through columns A, B and H
                x = .Areas(i).Column 'x represents the column number
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole) 'finds the header (row 10) in "Costing_tool"
                If Not header Is Nothing Then ' if found, executes next line of code
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy 'copies range starting in row 11 to lastrow in column
                    desWS.Cells(lastRow2, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 'pastes value to corresponding column in "Costing_tool"
                End If
            Next i
            With desWS
                If .Range("A" & .Rows.Count).End(xlUp).Row > 5 Then [SIZE=3][U][I][B]Can you explain this line of code with a comment please?[/B][/I][/U][/SIZE]
                    desWS.ListObjects.Item("tblCosting").ListRows.Add 'inserts blank row with formulas
                End If
                'next 3 lines fill columns D, F and G in "Costing_tool"
                .Range("D" & lastRow2 & ":D" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("G7") [SIZE=3][U][I][B]Can you explain this line of code with a comment please?[/B][/I][/U][/SIZE]
                .Range("F" & lastRow2 & ":F" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 & ":G" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("B6")
            End With
        Else 'if data already existed, executes next line of code; see above for explanatory comments
            lastRow2 = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row [SIZE=3][U][I][B]Can you explain this line of code with a comment please?[/B][/I][/U][/SIZE]
            desWS.ListObjects.Item("tblCosting").ListRows.Add 'inserts blank row with formulas [SIZE=3][U][I][B]Can you explain this line of code with a comment please?[/B][/I][/U][/SIZE]
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole) [SIZE=3][U][I][B]Can you explain this line of code with a comment please?[/B][/I][/U][/SIZE]
                If Not header Is Nothing Then
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy [SIZE=3][U][I][B]Can you explain this line of code with a comment please?[/B][/I][/U][/SIZE]
                    desWS.Cells(lastRow2 + 1, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues [SIZE=3][U][I][B]Can you explain this line of code with a comment please?[/B][/I][/U][/SIZE]
                End If
            Next i
            With desWS
                .Range("D" & lastRow2 + 1 & ":D" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("G7") [SIZE=3][U][I][B]Can you explain this line of code with a comment please?[/B][/I][/U][/SIZE]
                .Range("F" & lastRow2 + 1 & ":F" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 + 1 & ":G" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B6")
            End With
        End If
    End With
    
    'sorts data by 'Date' in "Costing_tool"
    desWS.ListObjects("tblCosting").Sort.SortFields.Clear
    desWS.ListObjects("tblCosting").Sort.SortFields. _
        Add Key:=desWS.Cells(, 1), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With desWS.ListObjects("tblCosting").Sort
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Application
        .CutCopyMode = False 'clears clipboard to unselect ranges copied for pasting
        .EnableEvents = True 'enables event macros
        .ScreenUpdating = True 'turns screen updating back on so you can see the changes made by the macro
    End With
End Sub
Click to expand...

Thanks for this Mumps. There is just a few lines of code that I still don't understand. They are mainly the calculation lines and I don't know how they work. I have added a note in the above quote to show you what lines.

Thanks Mumps,
Dave
 
Upvote 0
Here you go:
Code: 
Option Explicit
Private Sub CmdSend_Click()
    Application.ScreenUpdating = False 'prevents screen flickering and speeds up the macro
    Application.EnableEvents = False 'prevents event macros from running which speeds up the macro and can avoid unwanted results or errors
    Dim desWS As Worksheet
    Dim srcWS As Worksheet
    Set srcWS = ThisWorkbook.Sheets("NPSS_quote_sheet") 'source worksheet
    Set desWS = ThisWorkbook.Sheets("Costing_tool") 'destination worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim x As Long
    Dim header As Range 'defines 'header' as a range variable that will hold the header name found in "Costing_tool"
    lastRow1 = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row 'finds last used row in column B of "NPSS_quote_sheet"
    lastRow2 = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'finds last used row in column A of "Costing_tool"
    With srcWS.Range("A:A,B:B,H:H") 'columns to copy
        If lastRow2 < 5 Then 'checks if there is any data already copied in "Costing_tool" starting at row 5
            lastRow2 = 5 'if no data, sets last row to 5 and continues to next line of code, otherwise goes to 'Else' line of code
            For i = 1 To .Areas.Count 'loops through columns A, B and H
                x = .Areas(i).Column 'x represents the column number
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole) 'finds the header (row 10) in "Costing_tool"
                If Not header Is Nothing Then ' if found, executes next line of code
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy 'copies range starting in row 11 to lastrow in column
                    desWS.Cells(lastRow2, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 'pastes value to corresponding column in "Costing_tool"
                End If
            Next i
            With desWS
                If .Range("A" & .Rows.Count).End(xlUp).Row > 5 Then 'Checks to see if there is more than one row of data and if so, executes next line
                    desWS.ListObjects.Item("tblCosting").ListRows.Add 'inserts blank row with formulas
                End If
                'next 3 lines find the range that needs to be filled with G7, B7 and B6 of "NPSS_quote_sheet" in columns D, F and G in "Costing_tool"
                .Range("D" & lastRow2 & ":D" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("G7")
                .Range("F" & lastRow2 & ":F" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 & ":G" & .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row) = srcWS.Range("B6")
            End With
        Else 'if data already existed, executes next line of code; see above for explanatory comments
            lastRow2 = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ''finds last used row in column A of "Costing_tool"
            desWS.ListObjects.Item("tblCosting").ListRows.Add 'inserts blank row with formulas Can you explain this line of code with a comment please?
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole) 'finds the headers in columns A, B and H in row 4 columns A, B and H
                If Not header Is Nothing Then
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy 'Copies the range starting in row 11 to last used row in columns A, B and H of "NPSS_quote_sheet"
                    desWS.Cells(lastRow2 + 1, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 'pastes the values in columns A, B and H in "Costing_tool"
                End If
            Next i
            With desWS
                'next 3 lines find the range that needs to be filled with G7, B7 and B6 of "NPSS_quote_sheet" in columns D, F and G in "Costing_tool"
                .Range("D" & lastRow2 + 1 & ":D" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("G7")
                .Range("F" & lastRow2 + 1 & ":F" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 + 1 & ":G" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B6")
            End With
        End If
    End With
    'sorts data by 'Date' in "Costing_tool"
    desWS.ListObjects("tblCosting").Sort.SortFields.Clear
    desWS.ListObjects("tblCosting").Sort.SortFields. _
        Add Key:=desWS.Cells(, 1), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With desWS.ListObjects("tblCosting").Sort
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Application
        .CutCopyMode = False 'clears clipboard to unselect ranges copied for pasting
        .EnableEvents = True 'enables event macros
        .ScreenUpdating = True 'turns screen updating back on so you can see the changes made by the macro
    End With
End Sub
 
Upvote 0
When I have several lines in npss_quote and I try to copy them to the costing tool when there is nothing in the costing tool, it creates an extra line in the costing tool. The line is blank and has nothing in it but it is not what I wanted as my supervisor wants it to be an exact copy of the rows in npss_quote. When I copy rows a second time, it seems to sort itself out but I want it to not have the extra blank row for the first I try and copy rows.

Not sure if I have changed the code or not but here is the latest code:

Code: 
Private Sub CmdSend_Click()
    Application.ScreenUpdating = False 'prevents screen flickering and speeds up the macro
    Application.EnableEvents = False 'prevents event macros from running which speeds up the macro and can avoid unwanted results or errors
    Dim desWS As Worksheet
    Dim srcWS As Worksheet
    Set srcWS = ThisWorkbook.Sheets("NPSS_quote_sheet") 'source worksheet
    Set desWS = ThisWorkbook.Sheets("Costing_tool") 'destination worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim x As Long
    Dim header As Range 'defines 'header' as a range variable that will hold the header name found in "Costing_tool"
    lastRow1 = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row 'finds last used row in column B of "NPSS_quote_sheet"
    lastRow2 = desWS.Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'finds last used row in column A of "Costing_tool"
    With srcWS.Range("A:A,B:B,H:H") 'columns to copy
        If lastRow2 < 5 Then 'checks if there is any data already copied in "Costing_tool" starting at row 5
            lastRow2 = 5 'if no data, sets last row to 5 and continues to next line of code, otherwise goes to 'Else' line of code
            For i = 1 To .Areas.Count 'loops through columns A, B and H
                x = .Areas(i).Column 'x represents the column number
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole) 'finds the header (row 10) in "Costing_tool"
                If Not header Is Nothing Then ' if found, executes next line of code
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy 'copies range starting in row 11 to lastrow in column
                    desWS.Cells(lastRow2, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 'pastes value to corresponding column in "Costing_tool"
                End If
            Next i
            With desWS
                If .Range("A" & .Rows.Count).End(xlUp).Row > 5 Then 'Checks to see if there is more than one row of data and if so, executes next line
                    desWS.ListObjects.Item("tblCosting").ListRows.Add 'inserts blank row with formulas
                End If
                'next 3 lines find the range that needs to be filled with G7, B7 and B6 of "NPSS_quote_sheet" in columns D, F and G in "Costing_tool"
                .Range("D" & lastRow2 & ":D" & .Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row) = srcWS.Range("G7")
                .Range("F" & lastRow2 & ":F" & .Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 & ":G" & .Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row) = srcWS.Range("B6")
            End With
        Else 'if data already existed, executes next line of code; see above for explanatory comments
            lastRow2 = desWS.Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row ''finds last used row in column A of "Costing_tool"
            desWS.ListObjects.Item("tblCosting").ListRows.Add 'inserts blank row with formulas Can you explain this line of code with a comment please?
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole) 'finds the headers in columns A, B and H in row 4 columns A, B and H
                If Not header Is Nothing Then
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy 'Copies the range starting in row 11 to last used row in columns A, B and H of "NPSS_quote_sheet"
                    desWS.Cells(lastRow2 + 1, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 'pastes the values in columns A, B and H in "Costing_tool"
                End If
            Next i
            With desWS
                'next 3 lines find the range that needs to be filled with G7, B7 and B6 of "NPSS_quote_sheet" in columns D, F and G in "Costing_tool"
                .Range("D" & lastRow2 + 1 & ":D" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("G7")
                .Range("F" & lastRow2 + 1 & ":F" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 + 1 & ":G" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B6")
            End With
        End If
    End With
    'sorts data by 'Date' in "Costing_tool"
    desWS.ListObjects("tblCosting").Sort.SortFields.Clear
    desWS.ListObjects("tblCosting").Sort.SortFields. _
        Add Key:=desWS.Cells(, 1), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With desWS.ListObjects("tblCosting").Sort
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        
    With Application
        .CutCopyMode = False 'clears clipboard to unselect ranges copied for pasting
        .EnableEvents = True 'enables event macros
        .ScreenUpdating = True 'turns screen updating back on so you can see the changes made by the macro
    End With
End Sub

Thanks Mumps,
Dave
 
Upvote 0
Yeah, sorry about that. But it is not solved yet. Look at that page to see the problem.
 
Upvote 0
Ok, but it's better to stick to one thread, so that everybody stays on the same page regarding the solution....:devilish:
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Solved
Row Transfer Macro
Replies
9
Views
92
mumps
mumps
C
  • Solved
Manipulate the appearance of a spreadsheet in VBA
2
Replies
14
Views
403
mumps
mumps
W
  • Locked
  • Question
Copy rows and add column per month
Replies
2
Views
148
Fluff
Fluff
U
  • Question
Information overwriting when transferring
Replies
7
Views
284
UTB
U
S
  • Question
Go to cell in very last column of the active row
Replies
2
Views
246
Fluff
Fluff

Forum statistics

Threads
1,215,365
Messages
6,124,511
Members
449,166
Latest member
hokjock

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