VBA:每个循环改变范围

我正在尝试使用VBAmacros来遍历文件夹中的所有.xlsx文件,并将每个文件夹中相同范围/表单的值复制到包含该macros的文件中。

如何在每个循环中更改ThisWorkbook的范围?

 ThisWorkbook.Worksheets(1).Range("I4:AV83").Value = wb.Worksheets(3).Range("A4:AN83").Value 

打开的文件的范围将始终为A4:AN83 。 范围I4:AV83是要复制的第一个文件的范围, 第二个将是I84:AV163第三个 I164:AV243 ,等等。

其余代码如下,并从www.TheSpreadsheetGuru.com改编

 *original code* 

编辑:谢谢你的回应。 由于代码相当长,我已经删除它,并发布了下面的更新版本。

我添加在.Range(Cells(9, y1), Cells(48, y2)) ,现在有一个问题,它将更新从一个加载的工作表错误的范围内的值。

第一张纸的值应该出现在范围I4:AV83 ,但是只有一些最后一张纸的值出现在范围I9:AV48

 Private Sub CommandButton1_Click() Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog Dim y1 As Integer Dim y2 As Integer 'Set y1 and y2 for value range y1 = 4 y2 = 83 'Optimizes Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'If folder is not selected NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension (must include wildcard "*") myExtension = "*.xlsx*" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) 'Loop through each Excel file in folder Do While myFile <> "" 'Set variable equal to opened workbook Set wb = Workbooks.Open(Filename:=myPath & myFile) 'Ensure Workbook has opened before moving on to next line of code DoEvents 'Sets values to the looped file's ThisWorkbook.Worksheets(1).Range(Cells(9, y1), Cells(48, y2)).Value = wb.Worksheets(3).Range("A4:AN83").Value 'Closes opened Workbook wb.Close 'Ensure Workbook has closed before moving on to next line of code DoEvents 'Update range for next loop y1 = y1 + 80 y2 = y2 + 80 'Get next file name myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Complete" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

如果用wb.Worksheets(3).Range(Cells(x, y), Cells(x2, y2)).Valuereplacewb.Worksheets(3).Range("A4:AN83").Value ,在每个循环中增加x,y,x2和y2。