循环和设定值为coulmns

时间:2016-06-08 18:28:11

标签: excel vba excel-vba

我目前正在使用set value方法从多个工作簿中复制数据。我现在可以循环遍历所有工作簿并设置一个工作表,工作表2(标题)中的值,如下所示,并将它们复制到我的目的地“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

1 个答案:

答案 0 :(得分:0)

我不完全确定这是否是您所要求的,但我认为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