Vba 在excel电子表格之间复制信息的代码

我试图找出如何执行宏，该宏将数据从一张名为Master sheet的工作表复制到另一张名为201511th的工作表上，但仅当在Master sheet的k列中找到201511th时。如果在K列中找到了2015年11月，则我需要将单元格C、H和J（该行）中的所有数据复制到活页2015年11月的相应列A、B和C中。我必须将此代码复制几次。因此，它对应于销售月，以创建该月的预计销售管道

我一直在看视频，也试过了，但还是想不出来

我需要它找到下一个空白行插入它，我需要它不复制任何数据。任何帮助都将不胜感激！我正在使用Excel 2011

这是我一直在使用的代码

Sub copycolumns()
Dim lastrow As Long, erow as long

Lastrow=sheet1.cells(rows.count,1).end(xlUp).Row

for i=4 to lastrow
Sheet1.Cells(i,1).Copy
erow=sheet2.Cells(Rows.Count,1).end(xlUp).Offset(1,0).Row

sheet1.Paste Destination=Worksheets(“Sheet2”).Cells(erow,1)

sheet1.Cells(i,3).Copy
sheet1.Paste Destination=Worksheets(“Sheet2”).Cells(erow,2)

sheet1.Cells(i,8).Copy
sheet1.Paste Destination=Worksheets(“Sheet2”).Cells(erow,3)

sheet1.Cells(i,10).Copy
sheet1.Paste Destination=Worksheets(“Sheet2”).Cells(erow,4)

Next i

application.CutCopyMode = False
sheet2.columns().Autofit
Range(“A1”).Select

这是怎么回事

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 11 Then
    Dim masterWS As Worksheet, altWS As Worksheet
    Dim copy1$, copy2$, copy3$
    Dim altLastRow&

    Set masterWS = Sheets("Master Sheet")
    On Error GoTo ErrHandler
    Set altWS = Sheets(Target.Value)
    On Error GoTo 0 ' ### EDIT By Scott Holtzman ###

    copy1 = masterWS.Cells(Target.Row, 3).Valu
    copy2 = masterWS.Cells(Target.Row, 8).Value
    copy3 = masterWS.Cells(Target.Row, 10).Value

    altLastRow = altWS.Cells(altWS.Rows.Count, 1).End(xlUp).Row
    If Not IsEmpty(altWS.Cells(1, 1)) Then altLastRow = altLastRow + 1
    altWS.Cells(altLastRow, 1).Value = copy1
    altWS.Cells(altLastRow, 2).Value = copy2
    altWS.Cells(altLastRow, 3).Value = copy3

ErrHandler:
    Dim addSheet$
    If Err.Number = 9 Then
        addSheet = MsgBox("The " & Target.Value & " sheet doesn't exist, create it?", vbYesNo)
        If addSheet = vbYes Then
            Sheets.Add.Name = Target.Value
            Sheets(Target.Value).Move after:=masterWS
            Set altWS = Sheets(Target.Value)
        Else
            Exit Sub
        End If
        Resume Next

    End If
End If
masterWS.Activate
End Sub

很简单。我对它进行了测试，它对我很有效：

“母版纸”：

“2015年11月”表：

编辑：更新为包含错误处理程序，以防工作表不存在。（注意：我对错误处理程序还很陌生，所以如果有人给我一些提示/建议，我将不胜感激！）

---

Edit2：更新为

工作表\u更改

。将此代码放入“主工作表”模块。

将此代码放入

主工作表

模块

我知道你说你的工作表已经存在了，但是我添加了一些错误测试，以防你输入的名称错误或者根本没有工作表。代码假定图纸名称与K列中的销售日期相同

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 11 Then ' column K

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(Target.Value2)
    On Error GoTo 0 

    If Not ws Is Nothing Then 

         With ws

             Dim lRow As Long
             lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1

             .Range("A" & lRow).Value = Me.Cells(Target.Row, 3) ' Column C
             .Range("B" & lRow).Value = Me.Cells(Target.Row, 8) ' Column H
             .Range("C" & lRow).Value = Me.Cells(Target.Row, 10) ' Column J

         End With

    Else

         Msgbox "Sheet Does Not Exist! Add sheet and modify cell again!"

    End If

End If

End Sub

---

你指的是哪些视频？我根据我的工作表更改了字段，收到了错误扫描您发布的任何代码？此外，“Novenmber2015”是否可以在K列的任何单元格中？或者在出现“Novenmber2015”的地方，使用该行？因此，如果销售日期发生变化，则在k列中，我希望反映在与该月相关的表格中。我有我可以发送的表格，以便您更好地理解。但如果我将其更改为2015年12月，那么我希望它移动到标题为2015年12月的表格，以便我可以更改k列中的信息。我现在要测试它。但不管怎样，非常感谢你，我也非常感激。。5.我一试用就会告诉你最新情况minutes@JenniferBlandino-当您进行更改时，它不会运行。不过我可以更新它，只是澄清一下：您所做的更改将是对K列的更改，并且在进行更改时，您希望宏运行。是否希望它在K列中具有值的所有单元格中运行？还是就在你换的那一排？你说的所有单元格都换了是什么意思？太好了@Scott！很好，我编辑了它，如果他们点击“否”，我就把它留下。布鲁斯-我编辑了你的代码，并用注释标记放在那里。如果你想的话，你可以重新编辑或删除，只是觉得这样更容易。我们今天也这么想，我喜欢错误处理。我（巧合地！）也添加了一个错误处理程序，但我不确定我是否正确/有效地添加了错误处理程序-你介意看一眼吗？我将其粘贴到模块中并保存。但什么也没发生。我应该删除我创建的工作表吗？看起来很不错@BruceWayne。我只需将

On Error GoTo ErrHandler

语句移动到

Set altWS=Sheets（cel.Value）

语句之前，因为在此之前您不希望代码出现在那里。然后在

Set altWS…

语句之后添加

On Error GoTo 0

，这样它就不会再转到那里了。。。。（实际上，

ResumeNext

可能就足够了）@jenniferbandino。在K列中更改sales date以触发运行代码的事件。保留所有床单！同时将

REM

注释标记替换为

”

。告诉我发生了什么或没有发生什么？（我无法完全测试，因为我没有您的数据，但它对我来说非常有用）