从工作簿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
答
只是在添加更多天。 下面的代码也将增加在周一,做同样为一周的休息
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
答
如果你不想打开和关闭另一个工作簿,那么下面的代码可能会更好。
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
看一看这个:https://*.com/questions/19351832/copy-from-one-workbook-and-paste-into-another,然后告诉我们你尝试过什么。 –
[复制一个工作簿并粘贴到另一个]可能的重复(https://*.com/questions/19351832/copy-from-one-workbook-and-paste-into-another) – ChrisM