ワークブック1のシートからワークブック2の複数のシートにコピー

Question

ワークブック1にExcelシートがあり、そのシートのデータ行を日にち（日曜日、月曜日...）にコピーしたいのですが、 別のワークブック（日）には、毎日別のシートがあります。私が見つけた

すべての例では、別のブックに1つのワークブックからわずか1枚に

をコピーして、あなたはこれで私を助けていただけますか？

私はこのコードを使用していますが、私は他の日のためにそれを繰り返すようにしようとしたときのコードは、あなたが他のものにコピーするだけで探しているなら、私は方法

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 

Answer 1

ただ、以下のコードはまた、月曜日に追加されます。 で、週

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 

の残りの部分と同じ操作を行います。また、一度だけ、他のワークブックを開くことによって、効率を向上させることができ、より日追加後に保存するだけです。

Answer 2

保存オープン&を使用する場合に特に混乱しますシートの場合は、他の日のコードを繰り返すことができます。

Answer 3

他のワークブックを開いたり閉じたりしたくない場合は、以下のコードを使用してください。

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