宏根据条件将行的特定列复制/粘贴到新工作表中

-1

这是我的第一篇文章，请耐心等待。

我正在使用代码（来自此站点）查看特定工作表的A列中的列表，并从此列表创建/命名新工作表（如果它们尚不存在）。它还将具有匹配名称的行中的数据复制到各自的表中。

我想知道的是如何更改代码，以便不是将整行复制到新工作表，而只是复制列A:P。我真的很感激任何帮助。这是代码：

Sub yearAssign()
    Application.ScreenUpdating = False
    On Error GoTo SheetError
    sheetname = "initial"
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim wks1 As Worksheet
    Set wkb = ThisWorkbook
    Set wks = Sheets(sheetname)
    totalsheets = wkb.Worksheets.Count
    For i = 1 To totalsheets
        Set wks1 = wkb.Worksheets(i)
        thename = wks1.Name
        If thename <> sheetname Then
            wks1.Rows.Clear
        End If
    Next i
    totalrows = wks.Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To totalrows
        theyear = wks.Cells(i, 1)
        Set wks1 = Sheets(theyear)
        lastrow = wks1.Cells(Rows.Count, "A").End(xlUp).Row + 1
        If lastrow = 2 Then
            wks.Rows(1).Copy Destination:=Sheets(theyear).Range("A1")
        End If
        wks.Rows(i).Copy Destination:=Sheets(theyear).Range("A" & lastrow)
    Next i
    Application.ScreenUpdating = True
    finish = MsgBox("Finished", vbInformation)

    SheetError:
    If Err.Number = 9 Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = theyear
        Resume
    End If
End Sub

microsoft-excel microsoft-excel-2010 vba

— FANK
source

我建议您录制自己的宏。它非常简单，按记录，执行程序，按停止，检查代码。使用此代码只会让您感到沮丧，而且只会导致特定问题; 这就是VBa的工作方式 - 具体问题。算法是可重用的，但编写工作的却不是。

— ejbytes 2016年

正在进行整行实际复制的行是：

wks.Rows(1).Copy Destination:=Sheets(theyear).Range("A1")

wks.Rows(i).Copy Destination:=Sheets(theyear).Range("A" & lastrow)

因此，如下修改它们将导致它们仅复制列A:P：

wks.Range("A1:P1").Copy Destination:=Sheets(theyear).Range("A1")

wks.Range("A" & i & ":" & "P" & i).Copy Destination:=Sheets(theyear).Range("A" & lastrow)

此外，该代码还有其他几个问题，包括但不一定限于以下内容：

1）缺少许多变量声明：

Dim sheetname As String
Dim totalsheets As String
Dim theyear As String
Dim thename As String
Dim i As Integer
Dim finish As Integer
Dim totalrows As Long
Dim lastrow As Long

2）sheetname在变量声明之前被设置

3）应该有一个通用的错误处理程序，并且Application.ScreenUpdating应该在True 发生任何错误时设置（否则，在错误发生后该过程完成时Application.ScreenUpdating将保留False）

4）Sheets(theyear)执行复制的行中的出现应替换为wks1，因为该wks1变量已被设置为Sheets(theyear)

请注意，Option Explicit在模块顶部指定将有助于引起对＃1和＃2等问题的注意，因为在问题得到解决之前，代码将无法编译。

— MJH
source