dpaton05
Well-known Member
- Joined
- Aug 14, 2018
- Messages
- 2,375
- Office Version
- 365
- 2016
- Platform
- Windows
I am trying to write some code to copy to another document and it is not working.
Here is the code:
I try and run it and it says subscript out of range and highlights this line:
I have tried to trace it and everything seems to be entered. Can someone help me please?
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?