CODEWITHSUNDEEP
vbaexcel
MTJ
MTJ

Reputation: 99

VBA: Changing range with each loop

I'm trying to use a VBA macro to loop through all .xlsx files in a folder and copy values from the same range/sheet in each into the file containing the macro.

How do I change the range for ThisWorkbook with each loop?

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

The range for the opened file being looped through will always be A4:AN83. The range I4:AV83 is the range for the first file to be copied to, the second would be I84:AV163, the third I164:AV243, and so on.

The rest of the code is below, and is adapted from www.TheSpreadsheetGuru.com

*original code*

EDIT: Thank you to those who responded. Since the code was rather long I've removed it and posted an updated version below.

I added in the .Range(Cells(9, y1), Cells(48, y2)), and am now having an issue where it will update the values on the wrong range from only one of the loaded sheets.

The first sheet's values should appear on the range I4:AV83, but instead only some of the last sheet's values are appearing on the range 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

Upvotes: 1

Views: 3189

Answers (1)

jcarroll
jcarroll

Reputation: 577

If you replace wb.Worksheets(3).Range("A4:AN83").Value with wb.Worksheets(3).Range(Cells(x, y), Cells(x2, y2)).Value then you can easily increment x, y, x2, and y2 on each loop.

Upvotes: 1

Related Questions