用于复制Excel电子表格之间的信息的代码

我试图弄清楚如何做一个macros，将一张标题为Master Sheet的表格的数据复制到另一张标题为2015年11月的表格上，但是只有在主表格的k列中find了2015年11月的数据。 如果在K列中find2015年11月，那么我需要将单元格C，H和J（在该行上）中的所有数据复制到Sheet 2015年11月到相应的列A，B和C中。我必须复制这些代码倍。 以便它对应于销售月份来创build该月的估计销售渠道。

我一直在观看Youtubevideo，并尝试过，但无法弄清楚。

我需要它find下一个空白行插入它，我需要它不复制任何数据。 任何帮助，将不胜感激！ 我正在使用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 

Answer 1

这个怎么样：

 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 

非常简单 我testing了它，它对我来说还好：

“主表”：

“2015年11月”表：

编辑：更新为包含error handling程序，以防工作表不存在。 （注意：对于error handling程序我很新，所以如果有人有提示/build议，我会很感激！）。

编辑2：更新为Worksheet_Change 。 将此代码放在您的“主表”模块中。

Answer 2

将此代码放在Master Worksheet模块中。

我知道你说过你的床单已经在那里了，但是我添加了一些错误testing，以防你input错误的名字或没有床单。 该代码假定表格名称将等于K栏中的销售date。

 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