从工作簿1中的工作表复制到工作簿2中的多个工作表

问题描述:

我在工作簿1中有一个Excel工作表,我想根据当天(星期日,星期一...)使用VBA复制该工作表中的数据行,但要另一本工作日(天)每天有一个单独的工作表。从工作簿1中的工作表复制到工作簿2中的多个工作表

所有我发现从一个工作簿被复制到只有一张的另一个工作簿

能否请你帮我这个例子?

我使用这个代码,但是当我试图重复的其他日子里,我感到困惑,尤其是当使用开放&保存方法

Sub myTest() 
Dim LastRow As Integer, i As Integer, erow As Integer 
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 

For i = 2 To LastRow 

If Cells(i, 2).Value = "Sunday" Then 

Range(Cells(i, 1), Cells(i, 7)).Select 
Selection.Copy 
Workbooks.Open Filename:="C:\Users\User1\Documents\Days.xlsx" 
Worksheets("Sunday").Select 
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
ActiveSheet.Cells(erow, 1).Select 
ActiveSheet.Paste 
ActiveWorkbook.Save 
ActiveWorkbook.Close 
Application.CutCopyMode = False 
End If 
Next i 
End Sub 
+0

看一看这个:https://*.com/questions/19351832/copy-from-one-workbook-and-paste-into-another,然后告诉我们你尝试过什么。 –

+0

[复制一个工作簿并粘贴到另一个]可能的重复(https://*.com/questions/19351832/copy-from-one-workbook-and-paste-into-another) – ChrisM

只是在添加更多天。 下面的代码也将增加在周一,做同样为一周的休息

Sub myTest() 
Dim LastRow As Integer, i As Integer, erow As Integer 
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 

For i = 2 To LastRow 

If Cells(i, 2).Value = "Sunday" Then 

Range(Cells(i, 1), Cells(i, 7)).Select 
Selection.Copy 
Workbooks.Open Filename:="C:\Users\User1\Documents\Days.xlsx" 
Worksheets("Sunday").Select 
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
ActiveSheet.Cells(erow, 1).Select 
ActiveSheet.Paste 
ActiveWorkbook.Save 
ActiveWorkbook.Close 
Application.CutCopyMode = False 
End If 

If Cells(i, 2).Value = "Monday" Then 

Range(Cells(i, 1), Cells(i, 7)).Select 
Selection.Copy 
Workbooks.Open Filename:="C:\Users\User1\Documents\Days.xlsx" 
Worksheets("Monday").Select 
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
ActiveSheet.Cells(erow, 1).Select 
ActiveSheet.Paste 
ActiveWorkbook.Save 
ActiveWorkbook.Close 
Application.CutCopyMode = False 
End If 

Next i 
End Sub 

你也可以只打开其他工作簿一次,提高工作效率之后只保存它。

+0

您可能还希望在For i = 2之前移动** Workbooks.Open **并在Next i后保存并关闭 – ChrisM

如果你的代码正在寻找只复制到另一个然后你可以重复其他日子的代码。

+0

我试过,但我没有知道我是否每次都必须使用open方法或何时应该保存 – simpatico

+0

查看您现在添加到问题中的代码是否仅将周日行添加到星期日表中? – ChrisM

+0

是所有匹配星期日的条件都复制到另一个工作簿中名为Sunday的工作表中,并且我希望在整个星期内完成 – simpatico

如果你不想打开和关闭另一个工作簿,那么下面的代码可能会更好。

Sub myTest() 
Dim LastRow As Integer, i As Integer, erow As Integer, Dayname As String 

Workbooks.Open Filename:="C:\Users\User1\Documents\Days.xlsx" 
ThisWorkbook.Activate 
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 

For i = 2 To LastRow 
ThisWorkbook.Activate 
Set DayName = Cells(i, 2).Value 

Range(Cells(i, 1), Cells(i, 7)).Select 
Selection.Copy 
Windows("Days.xlsx").Activate 
Worksheets(DayName).Select 
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
ActiveSheet.Cells(erow, 1).Select 
ActiveSheet.Paste 

Next i 
End Sub