Copy and paste columns 1 to 15 only-CodePudding

My code below works fine but I want to be able to copy and paste columns 1 to 15 only. Any help will do. Thanks

Sub copypaste()

'a = Worksheets("Planned Weekly Schedule").Cells(Rows.Count, 1).End(xlUp).Row
a = Application.CountA(Range("A2:A200"))
Dim ws As Worksheet
Dim ws1 As Worksheet
Set ws = Worksheets("Schedule View")
Set ws1 = Worksheets("Planned Weekly Schedule")

If Application.WorksheetFunction.CountIf(ws.Range("Y8:Y20000"), ws1.Range("A10")) = 0 And Application.WorksheetFunction.CountIf(ws.Range("A8:A20000"), ws1.Range("E10")) = 0 Then

For i = 2 To a

If Worksheets("Structure").Cells(i, 3).Value <> "" Then

    Worksheets("Structure").Rows(i).Copy
    Worksheets("Schedule View").Activate
    b = Worksheets("Schedule View").Cells(Rows.Count, 1).End(xlUp).Row
    b = Worksheets("Schedule View").Cells(b   1, 1).Select
       
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   ' ActiveSheet.PasteSpecial
    Worksheets("Planned Weekly Schedule").Activate
End If

Next

Application.CutCopyMode = False
ThisWorkbook.Worksheets("Planned Weekly Schedule").Cells(1, 1).Select
MsgBox ("Update Complete!")

Else

MsgBox ("Week Period & Location Already Added!!!")
'MsgBox (Application.WorksheetFunction.CountIf(ws.Range("A8:A20000"), ws1.Range("E10")))


End If
    
End Sub

CodePudding user response：

Copy columns 1 to 15 instead of the entire row.

With Worksheets("Structure")
    .Range(.Cells(i,1),.Cells(i,15)).Copy

    ...

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End With