dpaton05
Well-known Member
- Joined
- Aug 14, 2018
- Messages
- 2,375
- Office Version
- 365
- 2016
- Platform
- Windows
How do I modify this code to copy formulas from column I & J of the table tblCosting, of the row being copied to the file, whose name is stored in column 36 or 37 of the particular row? I am still learning to code so I tried to write several lines in the middle but they didn’t work. This code successfully copies the rows to the relevant sheet. The only problem is I need it to copy the tax and total formula too.
If you need the actual formulas I need entering, they are
I =IF(E5="*Activities",0,[Price
ex. GST]*0.1)
J =IF(E5="Activities",[@[Price
ex. GST]],[GST]+[Price
ex. GST])
and they need to go in the same spot in the destination workbook, columns I and J.
Thanks,
Dave
Code:
Sub cmdCopy()
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim tblrow As ListRow
Dim Combo As String
Dim sht As Worksheet
Dim tbl As ListObject
Dim LastRow As Long
Dim DocYearName As String
Application.ScreenUpdating = False
'assign values to variables
Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
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(, 8).Copy
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
[B] tblrow.Range(Cells(1, 9), Cells(1, 10)).Copy ‘This is the two lines of code I tried to put in[/B]
[B] .Cells.Range(1, 9).PasteSpecial xlPasteFormulas[/B]
'.Range("A" & Rows.Count).End(xlUp).Offset(8).PasteSpecial xlPasteFormulas
'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
If you need the actual formulas I need entering, they are
I =IF(E5="*Activities",0,[Price
ex. GST]*0.1)
J =IF(E5="Activities",[@[Price
ex. GST]],[GST]+[Price
ex. GST])
and they need to go in the same spot in the destination workbook, columns I and J.
Thanks,
Dave
Last edited: