循環和coulmns的設置值

Question

我目前使用設置值方法從多個工作簿複製數據。我現在可以遍歷所有工作簿，並從一張工作表（worksheet2（Title））中設置值，如下所示，並將它們複製到我的目標「sheet1」上的「thisWorkbook」。如何循環使用工作表3到9，並使用相同的設置值方法將範圍A2：C57複製到G，H，I列中？

Sub GetData() 
Dim MyPath As String 
Dim FileName As String 
Dim SheetName As String 
Dim NewRow As Long 

MyPath = "C:\attach" 
SheetName = "Title" 

FileName = Dir(MyPath & "\*.xlsx") 
Do While FileName <> "" 
If FileName <> ThisWorkbook.Name Then 
With ThisWorkbook.Sheets("Sheet1") 
NewRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 

With .Range("A" & NewRow) 
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!B4" 
.Value = .Value 
End With 
With .Range("B" & NewRow) 
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!B5" 
.Value = .Value 
End With 
With .Range("C" & NewRow) 
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!B6" 
.Value = .Value 
End With 
With .Range("D" & NewRow) 
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!B7" 
.Value = .Value 
End With 
With .Range("E" & NewRow) 
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!A1" 
.Value = .Value 
End With 
With .Range("F" & NewRow) 
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!A2" 
.Value = .Value 
End With 

'Copy the range A2:C57 from workheets (3 to 9) and past into columns G,H,I in thisworkbook from every workbook in folder. 
'For sheets 3 to 9 set the value range A2:C57 to G,H,I in thisworkbook. This would be done for every workbook in the folder 

End With 
End If 
FileName = Dir 

Loop 
ThisWorkbook.Sheets("Sheet1").Columns.AutoFit 
End Sub 

Answer 1

我不完全確定這是不是你問的，但我認爲range.copy是你想要的。

要得到整個工作表3-9可以使用

' A2:C57 = Cells (2,1),Cells(57,3) 
For Sheetindex= 3 to ThisWorkbook.Worksheets.Count 
'Copy Worksheet 3 A2:C57 

Set SourceRange = ThisWorkbook.WorkSheets(Sheetindex).Range(Cells(2,1),Cells(57,3)) 

' Paste it in Columns G,H,I starting in Row 1. 


SourceRange.Copy (ThisWorkbook.Worksheets("Sheet1").Cells("G1")) 

Next Sheetindex