code to copy to another document

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,362
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I am trying to write some code to copy to another document and it is not working.

Here is the code:

Code:
Private Sub CmdSend_Click()

Dim tbl As ListObject
Dim newRow As ListRow
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim tblrow As ListRow
Dim Combo As String
Dim sht As Worksheet
Dim lastrow As Long
Dim DocYearName As String
Dim Quote As String
Dim currentWB As Workbook



       
        Application.ScreenUpdating = False
        'assign values to variables
        
        Quote = "costing.xlsm"
        Set tbl = Workbooks("costing tool").Worksheets("home").ListObjects("tblCosting")
        Set currentWB = ActiveWorkbook
        
        'add a row at the end of the table
        Set newRow = tbl.ListRows.Add
            newRow.Range(28) = 1 'assuming the first column of your table is in Column A. Adjust as necessary
        
            
        
       ' For Each tblrow In tbl.ListRows
           ' If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
         '   MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
         '   Exit Sub
         '  End If
          '  Next tblrow
        For Each tblrow In tbl.ListRows
            Combo = tblrow.Range.Cells(1, 26).Value
            'lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
                If tblrow.Range.Cells(1, 6).Value = "Anglicare Western" Then
                    DocYearName = tblrow.Range.Cells(1, 37).Value
                Else
                    DocYearName = tblrow.Range.Cells(1, 36).Value
                End If
            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
                With wsDst
                    'This copies the first 10 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 15).Copy
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'This should go to the 15th column in the current row, i.e. column O, and copy that column and the next 2 columns, i.e. O:Q, to column K on the destination sheet.
                        'tblrow.Range.Offset(, 14).Resize(, 3).copy
                        '.Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'Similarly this should copy columns AD:AF from the table to column N on the destination sheet.
                        'tblrow.Range.Offset(, 29).Resize(, 3).copy
                        '.Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'Sort rows based on date
                        Rows("3:1000").Select
                        Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Clear
                        Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Add Key:=Range("A4:A1000"), _
                            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                                With Workbooks(DocYearName).Worksheets(Combo).Sort
                                    .SetRange Range("A3:AJ1000")
                                    .Header = xlYes
                                    .MatchCase = False
                                    .Orientation = xlTopToBottom
                                    .SortMethod = xlPinYin
                                    .Apply
                                End With
                End With
        Next tblrow
         
        Application.CutCopyMode = False
        Application.ScreenUpdating = True


End Sub

I try and run it and it says subscript out of range and highlights this line:
Code:
Set wsDst = Workbooks(DocYearName).Worksheets(Combo)

I have tried to trace it and everything seems to be entered. Can someone help me please?
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
I have tried to debug it a bit more and this is my code now:

Code:
Private Sub CmdSend_Click()

Dim tbl As ListObject
Dim newRow As ListRow
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim tblrow As ListRow
Dim Combo As String
Dim sht As Worksheet
Dim lastrow As Long
Dim DocYearName As String
Dim Quote As Workbook
Dim currentWB As Workbook



       
        Application.ScreenUpdating = False
        'assign values to variables
        
        Quote = Workbooks("costing tool.xlsm").Worksheets("home")
        Set tbl = Workbooks("costing tool").Worksheets("home").ListObjects("tblCosting")
        Set currentWB = ActiveWorkbook
        
        'add a row at the end of the table
        Set newRow = tbl.ListRows.Add
            newRow.Range(28) = 1 'assuming the first column of your table is in Column A. Adjust as necessary
        
            
        
       ' For Each tblrow In tbl.ListRows
           ' If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
         '   MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
         '   Exit Sub
         '  End If
          '  Next tblrow
        For Each tblrow In tbl.ListRows
            Combo = tblrow.Range.Cells(1, 26).Value

            'lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
                If tblrow.Range.Cells(1, 6).Value = "Anglicare Western" Then
                    DocYearName = Quote.Cells(1, 37).Value
                Else
                    DocYearName = Quote.Cells(1, 36).Value
                End If
            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
                With wsDst
                    'This copies the first 10 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 15).Copy
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'This should go to the 15th column in the current row, i.e. column O, and copy that column and the next 2 columns, i.e. O:Q, to column K on the destination sheet.
                        'tblrow.Range.Offset(, 14).Resize(, 3).copy
                        '.Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'Similarly this should copy columns AD:AF from the table to column N on the destination sheet.
                        'tblrow.Range.Offset(, 29).Resize(, 3).copy
                        '.Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'Sort rows based on date
                        Rows("3:1000").Select
                        Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Clear
                        Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Add Key:=Range("A4:A1000"), _
                            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                                With Workbooks(DocYearName).Worksheets(Combo).Sort
                                    .SetRange Range("A3:AJ1000")
                                    .Header = xlYes
                                    .MatchCase = False
                                    .Orientation = xlTopToBottom
                                    .SortMethod = xlPinYin
                                    .Apply
                                End With
                End With
        Next tblrow
         
        Application.CutCopyMode = False
        Application.ScreenUpdating = True


End Sub

It highlights this line near the top:
Code:
Quote = Workbooks("costing tool.xlsm").Worksheets("home")

and says object variable or with block variable not set.

Any help please?
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,971
Members
452,371
Latest member
Frana

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