syntax of for...next loop

[dpaton05]

Is there anything wrong with the syntax of my for next loop?

Sub cmdCopyr()
Application.ScreenUpdating = False

'declare variables
Dim TableLastRow As Long
Dim LastRow As Long
Dim TableNumberRows As Long
Dim iCounter As Long                                    'counter of for..next loop
Dim tblRows As Integer                                  'number of rows in tblCosting
Dim tblrow As ListRow                                   'specific row in tblCosting
Dim Combo As String                                     'Combo worksheet name
Dim sht As Worksheet
Dim Start As Long                                       'number of first row in tblCosting
Dim Costing As String

'assign values to variables
Set sht = Worksheets("home")

    With sht


        TableLastRow = Split(Sheets("Home").ListObjects("tblCosting").DataBodyRange.Address, "$")(4)            'last row in tblCosting of home sheet
        Combo = Worksheets("Home").Range("Y5")                                                                  'concaternation of cells to get name of worksheet to put data
        LastRow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
        Costing = Worksheets("home").ListObjects("tblCosting")
        
'        TableNumberRows = Rows("tblCosting")                                          'Worksheets("home").ListObjects("tblCosting").Rows.Count
        Start = "5"
        
         
        For iCounter = Start To TableLastRow Step 1
            .ListObjects("tblCosting").Range.Cells(iCounter, 1).Resize(, 10).copy
            With Worksheets(Combo).Cells(LastRow, iCounter)
                .PasteSpecial Paste:=xlPasteValues
                .Columns("A").NumberFormat = "dd/mm/yyyy"
            End With
            .ListObjects("tblCosting").Range.Cells(iCounter, 1).copy
                Worksheets(Combo).Cells(LastRow, 11).PasteSpecial Paste:=xlPasteValues
            .ListObjects("tblCosting").Range.Cells(iCounter, 30).Resize(, 32).copy
                Worksheets(Combo).Cells(LastRow, 14).PasteSpecial Paste:=xlPasteValues
        Next iCounter
        
                'Check if activities is selected in column I
                If Worksheets("home").Range("I5") = "Activities" Then
                    Worksheets(Combo).Range("K" & LastRow).Value = Worksheets("home").Range("AC" & LastRow)          'copy formula to total column if activities are selected
                    
                    'Worksheets(Combo).Range("I" & Lastrow).ClearContents                                            'clear gst component if activities are selected
                Else
                    Worksheets(Combo).Range("L" & LastRow).Formula = "=K" & LastRow & "*.1"                       'if activities are not selected, GST formula will be added in to column H
                    Worksheets(Combo).Range("M" & LastRow).Formula = "=L" & LastRow & "+K" & LastRow               'if activities are not selected, add formula in to column I that will sum columns G + H
                End If
                
            Worksheets(Combo).Columns("H:J").NumberFormat = "$#,##0.00"                                             'format values in columns G to I of Combo
            Call SortDates                                                                                          'format cells to be in ascending date order
    End With
    Application.CutCopyMode = False                                                                         'cancel Cut or Copy mode

    
Application.ScreenUpdating = True
End Sub

Thanks

 

[Norie]

Dave

Are all the columns to be copied in the table?


If they are try this.

Sub cmdCopyo()
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim tbl As ListObject
Dim tblrow As ListRow
Dim Combo As String

    Application.ScreenUpdating = False

    Set wsSrc = Worksheets("Home")

    With wsSrc

        Set tbl = .ListObjects("tblCosting")
        
        For Each tblrow In tbl.ListRows
            Combo = Format(tblrow.Range.Cells(1, 1), "mmmm yyyy")
            Set wsDst = Sheets(Combo)
            
            With wsDst
                tblrow.Range.Resize(, 10).Copy
                .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                tblrow.Range.Offset(, 14).Resize(, 3).Copy
                .Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                tblrow.Range.Offset(, 29).Resize(, 3).Copy
                .Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            End With
            
        Next tblrow
        
        Call SortDates
        
    End With
    
    Application.CutCopyMode = False

    Application.ScreenUpdating = True
    
End Sub

 

[dpaton05]

Are all the columns to be copied in the table?
[/code]

No they aren't. Some are used for calculations. The only cells I need copied are:

1. Columns A-J
2. Columns O-Q
3. Columns AD-AF

Thanks so much for this help Norie

 

[Norie]

Again I'm confused, which columns are in the table and which aren't?

Also, where is the table located?

PS Did you try the last code I posted?

 

[dpaton05]

Again I'm confused, which columns are in the table and which aren't?

Also, where is the table located?

PS Did you try the last code I posted?

Sorry to be confusing and not explain things, I will try again.

• tblCosting has 32 columns, so A - AF.
• These are the columns that information needs to be entered in by a work collegue.
• Some of these columns are just used for calculation purposes, such as "Number of Staff" or "Number of hours". I have tables in another sheet and use a index and match, match formula to lookup values, to perform calculations, depending on previous selections.
• I don't need these cells copied across (for instance, the number of hours).
• When all the required data is has been entered in tblCosting it will have information that spans across to column AF for each row.
• I need columns A-J from tblCosting, copied to the relevant monthly sheet first (for instance, if the date of the costing was in March 2019, I need it copied to the "March 2019" sheet.
• Using the last example, once columns A-J are in the March 2019 sheet, I need columns O-Q copied across so they are next to A-J. On the monthly sheet, columns O-Q will appear in the columns K-M.
• This is just as if the whole row of tblCosting was copied across to the monthly sheet and the 4 columns in the middle of A-J and O-Q were left out.

Just imagine I want the whole row of tblCosting copied to the monthly sheet but then the columns K-N are deleted, so it just moves the rest across 4 columns.

The tblCosting is located on the "Home" sheet.

I did try the code you pasted but it only copied up to columns J.

Thanks Norie

 

[Norie]

The code I posted should do what you want.

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(, 10).Copy
                .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

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 xlPasteValues

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 xlPasteValues

 

[dpaton05]

This is my code now and I get an error saying subscript out of range with the following code highlighted.

Sub cmdCopyo()
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim tblrow As ListRow
Dim Combo As String
Dim sht As Worksheet
Dim tbl As ListObject


    Application.ScreenUpdating = False
    
    'assign values to variables
    Set sht = Worksheets("Home")

    With sht

        Set tbl = .ListObjects("tblCosting")
        
        For Each tblrow In tbl.ListRows
            Combo = Format(tblrow.Range.Cells(1, 1), "mmmm yyyy")
            [COLOR=#ff0000]Set wsDst = Sheets(Combo)[/COLOR]
            
            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(, 10).copy
                .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                '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 xlPasteValues
                '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 xlPasteValues
            End With
            
        Next tblrow
        
        Call SortDates
        
    End With
    
    Application.CutCopyMode = False

    Application.ScreenUpdating = True
    
End Sub

 

[dpaton05]

Sorry, I just realised that there was a blank row at the bottom of the table. I took that out and it worked! YAY! Thank you Norie, you are such a LEGEND!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

 

[dpaton05]

Wait, I found a problem.

 

[dpaton05]

Download the spreadsheet and press the big button on the home sheet. It will copy entries correctly but it won't copy columns O - Q of the home sheet when activities are selected to the monthly sheets.

https://drive.google.com/open?id=1V2Ycrex6QL1pk_jSpLfdavncbHa6jtyb

 

[dpaton05]

Just tried the link and it didn't work for me so I will try and explain it.


Whenever I try and copy anything to the August 2018 tab, it won't copy columns O-Q of the home sheet but will copy everthing before and after it. It seems to copy fine to other monthly sheets but for some reason won't copy those 3 columns to that sheet. Any help would be greatly appreciated! I am getting so close to finishing this project and am super excited!