Repetative Code Advice

[colmmc]

Hi all,

I've been using Excel for decades but I've only just started using VBA.

I currently have a task that entails copying 600 cells from several sheets in one workbook to a table in another. And then repeating the process on 300 other workbooks

The code is quite simple

Sheets("Section 4a").Activate
Range("F8").Copy
Workbooks("master_table.xlsx").Activate
ActiveSheet.Paste
ActiveCell.Offset(0,1).Activate

It all works fine and the only thing that needs to change is the source sheet (Section 4 in the above example) and the copy range (F8) each time.

I'm wondering if two arrays would be easier/quicker? I've not used arrays before.


Any advice?

 

[JonXL]

For looping, try this:

Dim ws As Worksheet 

For Each ws in ThisWorkbook.Worksheets
   ws.Activate
   Range("F8").Copy
   Workbooks("master_table.xlsx").Activate
   ActiveSheet.Paste
   ActiveCell.Offset(0,1).Activate
Next ws

ABE: Sorry, I see you also want to change the Range each time, too. Is there any logic to which Range is used on each sheet?

 

[colmmc]

Thanks for the reply, JonXL,

Not really. The source sheet is a ten page application form filled out by 300 different people. My task is to tabulate all their responses which are scattered over 600 cells in each workbook.

 

[JonXL]

Do you at least know which sheets you need and which cells are needed from each sheet? (And will that always be the same?)

Should also be able to work with that...

 

[JonXL]

If your answer was 'yes' to those questions, try something like this:

Sub UpdateSheets()
Dim aSheet(1 To 2) As String
Dim aRange(1 To 2) As String
Dim a As Long


aSheet(1) = "Sheet1"
aSheet(2) = "Sheet2"

aRange(1) = "F8"
aRange(2) = "G10"

For a = 1 To 2
   Sheets(aSheet(a)).Activate
   Range(aRange(a)).Copy
   Workbooks("master_table.xlsx").Activate
   ActiveSheet.Paste
   ActiveCell.Offset(0, 1).Activate
Next a

End Sub

Just add/modify the Sheet and Range values as needed - make sure to increase the arrays in the Dim statements to account for values you want to add.

 

[Fluff]

Another option

Sub chk()
   Dim Ary As Variant
   Dim i As Long
   arr = Array("Sheet1", "F8", "Sheet2", "H37", "Sheet3", "I19")
   For i = 0 To UBound(Ary) Step 2
      Sheets(Ary(i)).Range(Ary(i + 1)).Copy
      Workbooks("master_table.xlsx").Activate
      ActiveSheet.Paste
      ActiveCell.Offset(0, 1).Activate
   Next i
End Sub