☰

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

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 vba
根据条件将某一行的特定列复制/粘贴到新工作表中的宏

这是我的第一篇帖子，请耐心等待。

我正在使用代码（来自这个网站) 查看特定工作表 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

答案1

实际复制整行的代码如下：

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 的注意，因为在问题得到解决之前代码将不会编译。

相关内容