VBA: Apply loop to existing code

Greetings,

I have the below code working as intended, however the amount of items I need to apply this code to has increased from a handful to several hundred. So I would like to apply a loop to the following code so that it goes through every excel document in the folder and performs the task:

Code:

---

Sub InspectionSheetTransfer()
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim vFile As Variant

'Set source workbook
Set wbSource = ActiveWorkbook

'Open the source workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)

'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile

'Set selectedworkbook
Set wbTarget = ActiveWorkbook

'transfer values
    'Tag Number
    wbSource.Sheets("Sheet1").Range("A2").Value = wbTarget.Sheets("Insp. Sheet").Range("M8")
    'Location
    wbSource.Sheets("Sheet1").Range("C2").Value = wbTarget.Sheets("Insp. Sheet").Range("T8")
   
    'Equipment Description
    wbSource.Sheets("Sheet1").Range("E2").Value = wbTarget.Sheets("Insp. Sheet").Range("C10")
   
    'Manufacturer
    wbSource.Sheets("Sheet1").Range("J2").Value = wbTarget.Sheets("Insp. Sheet").Range("I10")
   
    'Model
    wbSource.Sheets("Sheet1").Range("K2").Value = wbTarget.Sheets("Insp. Sheet").Range("P10")
   
    'Serial Number
    wbSource.Sheets("Sheet1").Range("L2").Value = wbTarget.Sheets("Insp. Sheet").Range("M8")
   
    'Cable Reference
    wbSource.Sheets("Sheet1").Range("M2").Value = wbTarget.Sheets("Insp. Sheet").Range("C12")
   
    'Ex Protection
    wbSource.Sheets("Sheet1").Range("O2").Value = wbTarget.Sheets("Insp. Sheet").Range("H12")
   
    'Gas Group
    wbSource.Sheets("Sheet1").Range("P2").Value = wbTarget.Sheets("Insp. Sheet").Range("L12")
   
    'T Rating
    wbSource.Sheets("Sheet1").Range("Q2").Value = wbTarget.Sheets("Insp. Sheet").Range("O12")
   
    'IP Rating
    wbSource.Sheets("Sheet1").Range("R2").Value = wbTarget.Sheets("Insp. Sheet").Range("R12")
   
    'Cert Number
    wbSource.Sheets("Sheet1").Range("S2").Value = wbTarget.Sheets("Insp. Sheet").Range("U12")
   
    'Drawing Number
    wbSource.Sheets("Sheet1").Range("T2").Value = wbTarget.Sheets("Insp. Sheet").Range("C14")
   
    'Grid Ref
    wbSource.Sheets("Sheet1").Range("U2").Value = wbTarget.Sheets("Insp. Sheet").Range("I14")
   
    'Area Class
    wbSource.Sheets("Sheet1").Range("W2").Value = wbTarget.Sheets("Insp. Sheet").Range("L14")
   
    'Cert Auth
    wbSource.Sheets("Sheet1").Range("X2").Value = wbTarget.Sheets("Insp. Sheet").Range("O14")
   
    'Access Normal
    wbSource.Sheets("Sheet1").Range("AE2").Value = wbTarget.Sheets("Insp. Sheet").Range("I15")
   
    'Access Ladder
    wbSource.Sheets("Sheet1").Range("AF2").Value = wbTarget.Sheets("Insp. Sheet").Range("M15")
   
    'Access Scaffold
    wbSource.Sheets("Sheet1").Range("AG2").Value = wbTarget.Sheets("Insp. Sheet").Range("Q15")
   
    'Access Ropes
    wbSource.Sheets("Sheet1").Range("AH2").Value = wbTarget.Sheets("Insp. Sheet").Range("U15")
   
    'Access Overside
    wbSource.Sheets("Sheet1").Range("AI2").Value = wbTarget.Sheets("Insp. Sheet").Range("Y15")
   
    'Area Class 0
    wbSource.Sheets("Sheet1").Range("AK2").Value = wbTarget.Sheets("Insp. Sheet").Range("F17")
   
    'Area Class 1
    wbSource.Sheets("Sheet1").Range("AL2").Value = wbTarget.Sheets("Insp. Sheet").Range("F18")
   
    'Area Class 2
    wbSource.Sheets("Sheet1").Range("AM2").Value = wbTarget.Sheets("Insp. Sheet").Range("F19")
   
    'Area Class Safe
    wbSource.Sheets("Sheet1").Range("AN2").Value = wbTarget.Sheets("Insp. Sheet").Range("F20")
   
    'Ignition Risk H
    wbSource.Sheets("Sheet1").Range("AP2").Value = wbTarget.Sheets("Insp. Sheet").Range("J17")
   
    'Ignition Risk m
    wbSource.Sheets("Sheet1").Range("AQ2").Value = wbTarget.Sheets("Insp. Sheet").Range("J18")
   
    'Ignition Risk L
    wbSource.Sheets("Sheet1").Range("AR2").Value = wbTarget.Sheets("Insp. Sheet").Range("J19")
   
    'Enviroment S
    wbSource.Sheets("Sheet1").Range("AT2").Value = wbTarget.Sheets("Insp. Sheet").Range("N17")
   
    'Enviroment m
    wbSource.Sheets("Sheet1").Range("AU2").Value = wbTarget.Sheets("Insp. Sheet").Range("N18")
   
    'Enviroment b
    wbSource.Sheets("Sheet1").Range("AV2").Value = wbTarget.Sheets("Insp. Sheet").Range("N19")
   
    'corrosion h
    wbSource.Sheets("Sheet1").Range("AX2").Value = wbTarget.Sheets("Insp. Sheet").Range("R17")
   
    'corrosion m
    wbSource.Sheets("Sheet1").Range("AY2").Value = wbTarget.Sheets("Insp. Sheet").Range("R18")
   
    'corrosion l
    wbSource.Sheets("Sheet1").Range("AZ2").Value = wbTarget.Sheets("Insp. Sheet").Range("R19")
   
    'vibration h
    wbSource.Sheets("Sheet1").Range("BB2").Value = wbTarget.Sheets("Insp. Sheet").Range("V17")
   
    'vibration m
    wbSource.Sheets("Sheet1").Range("BC2").Value = wbTarget.Sheets("Insp. Sheet").Range("V18")
   
    'vibration l
    wbSource.Sheets("Sheet1").Range("BD2").Value = wbTarget.Sheets("Insp. Sheet").Range("V19")
   
    'inspection date
    wbSource.Sheets("Sheet1").Range("BF2").Value = wbTarget.Sheets("Insp. Sheet").Range("L151")
   
    'grade of inspection
    wbSource.Sheets("Sheet1").Range("BG2").Value = wbTarget.Sheets("Insp. Sheet").Range("W24")
   
    'inspected by
    wbSource.Sheets("Sheet1").Range("BJ2").Value = wbTarget.Sheets("Insp. Sheet").Range("L154")
   
 
   
'close inspection sheet
wbTarget.Close

End Sub

---

In addition to applying the loop, the ability for the macro to enter a new line above once finished would be essentially (i.e, move the just completed line down 1)

Thank you very much for taking the time to read this, I look forward to your reply.

This will open a number of files and copy across, but each one will overwrite the previous, so if you want something else to happen, presumably you do, you need to say what, different ranges, different sheets?

Code:

---

Sub InspectionSheetTransfer()
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet
    Dim vFile As Variant
   
    'Set source workbook
    Set wbSource = ActiveWorkbook
    Set wsSource = wbSource.Worksheets("Sheet1")

    With Application.FileDialog(msoFileDialogOpen)
   
        .AllowMultiSelect = True
        .Filters.Add "Excel-files", "*.xlsx", 1
        .Title = "Select One File To Open"
       
        If .Show = 0 - 1 Then

            'Set selectedworkbooks
            Set wbTarget = ActiveWorkbook
            Set wsTarget = wbTarget.Sheets("Insp. Sheet")
           
            'transfer values
            With wsTarget
   
              'Tag Number
              wsSource.Range("A2").Value = wbTarget.Range("M8")
           
                'Location
              wsSource.Range("C2").Value = .Range("T8")
               
                'Equipment Description
              wsSource.Range("E2").Value = .Range("C10")
               
                'Manufacturer
              wsSource.Range("J2").Value = .Range("I10")
               
                'Model
              wsSource.Range("K2").Value = .Range("P10")
               
                'Serial Number
              wsSource.Range("L2").Value = .Range("M8")
               
                'Cable Reference
              wsSource.Range("M2").Value = .Range("C12")
               
                'Ex Protection
              wsSource.Range("O2").Value = .Range("H12")
               
                'Gas Group
              wsSource.Range("P2").Value = .Range("L12")
               
                'T Rating
              wsSource.Range("Q2").Value = .Range("O12")
               
                'IP Rating
              wsSource.Range("R2").Value = .Range("R12")
               
                'Cert Number
              wsSource.Range("S2").Value = .Range("U12")
               
                'Drawing Number
              wsSource.Range("T2").Value = .Range("C14")
               
                'Grid Ref
              wsSource.Range("U2").Value = .Range("I14")
               
                'Area Class
              wsSource.Range("W2").Value = .Range("L14")
               
                'Cert Auth
              wsSource.Range("X2").Value = .Range("O14")
               
                'Access Normal
              wsSource.Range("AE2").Value = .Range("I15")
               
                'Access Ladder
              wsSource.Range("AF2").Value = .Range("M15")
               
                'Access Scaffold
              wsSource.Range("AG2").Value = .Range("Q15")
               
                'Access Ropes
              wsSource.Range("AH2").Value = .Range("U15")
               
                'Access Overside
              wsSource.Range("AI2").Value = .Range("Y15")
               
                'Area Class 0
              wsSource.Range("AK2").Value = .Range("F17")
               
                'Area Class 1
              wsSource.Range("AL2").Value = .Range("F18")
               
                'Area Class 2
              wsSource.Range("AM2").Value = .Range("F19")
               
                'Area Class Safe
              wsSource.Range("AN2").Value = .Range("F20")
               
                'Ignition Risk H
              wsSource.Range("AP2").Value = .Range("J17")
               
                'Ignition Risk m
              wsSource.Range("AQ2").Value = .Range("J18")
               
                'Ignition Risk L
              wsSource.Range("AR2").Value = .Range("J19")
               
                'Enviroment S
              wsSource.Range("AT2").Value = .Range("N17")
               
                'Enviroment m
              wsSource.Range("AU2").Value = .Range("N18")
               
                'Enviroment b
              wsSource.Range("AV2").Value = .Range("N19")
               
                'corrosion h
              wsSource.Range("AX2").Value = .Range("R17")
               
                'corrosion m
              wsSource.Range("AY2").Value = .Range("R18")
               
                'corrosion l
              wsSource.Range("AZ2").Value = .Range("R19")
               
                'vibration h
              wsSource.Range("BB2").Value = .Range("V17")
               
                'vibration m
              wsSource.Range("BC2").Value = .Range("V18")
               
                'vibration l
              wsSource.Range("BD2").Value = .Range("V19")
               
                'inspection date
              wsSource.Range("BF2").Value = .Range("L151")
               
                'grade of inspection
              wsSource.Range("BG2").Value = .Range("W24")
               
                'inspected by
              wsSource.Range("BJ2").Value = .Range("L154")
            End With
           
            'close inspection sheet
            wbTarget.Close
        End If
    End With
End Sub

---

Hi xld,

That looks great, I'll be able to add a few lines to make enter a row in excel after each excel document is finished.

Although, I'm getting a Run-time error 9: Subscript out of range on the following:

Code:

---

Set wsTarget = wbTarget.Sheets("Insp. Sheet")

---

That suggests that there is no worksheet called 'Insp. Sheet' in the target workbook.

Sorry, just realised I missed an important bit

Code:

---

Sub InspectionSheetTransfer()
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet
    Dim vFile As Variant
    Dim i As Long
   
    'Set source workbook
    Set wbSource = ActiveWorkbook
    Set wsSource = wbSource.Worksheets("Sheet1")
   
    With Application.FileDialog(msoFileDialogOpen)
       
        .AllowMultiSelect = True
        .Filters.Add "Excel-files", "*.xlsx", 1
        .Title = "Select All Files To Open"
       
        If .Show = - 1 Then
           
           
            For i = 1 To .SelectedItems.Count
           
                'Set selectedworkbooks
                Set wbTarget = Workbooks.Open(.SelectedItems(i))
                Set wsTarget = wbTarget.Worksheets("Insp. Sheet")
           
                'transfer values
                With wsTarget
                   
                    'Tag Number
                    wsSource.Range("A2").Value = .Range("M8")
                   
                    'Location
                    wsSource.Range("C2").Value = .Range("T8")
                   
                    'Equipment Description
                    wsSource.Range("E2").Value = .Range("C10")
                   
                    'Manufacturer
                    wsSource.Range("J2").Value = .Range("I10")
                   
                    'Model
                    wsSource.Range("K2").Value = .Range("P10")
                   
                    'Serial Number
                    wsSource.Range("L2").Value = .Range("M8")
                   
                    'Cable Reference
                    wsSource.Range("M2").Value = .Range("C12")
                   
                    'Ex Protection
                    wsSource.Range("O2").Value = .Range("H12")
                   
                    'Gas Group
                    wsSource.Range("P2").Value = .Range("L12")
                   
                    'T Rating
                    wsSource.Range("Q2").Value = .Range("O12")
                   
                    'IP Rating
                    wsSource.Range("R2").Value = .Range("R12")
                   
                    'Cert Number
                    wsSource.Range("S2").Value = .Range("U12")
                   
                    'Drawing Number
                    wsSource.Range("T2").Value = .Range("C14")
                   
                    'Grid Ref
                    wsSource.Range("U2").Value = .Range("I14")
                   
                    'Area Class
                    wsSource.Range("W2").Value = .Range("L14")
                   
                    'Cert Auth
                    wsSource.Range("X2").Value = .Range("O14")
                   
                    'Access Normal
                    wsSource.Range("AE2").Value = .Range("I15")
                   
                    'Access Ladder
                    wsSource.Range("AF2").Value = .Range("M15")
                   
                    'Access Scaffold
                    wsSource.Range("AG2").Value = .Range("Q15")
                   
                    'Access Ropes
                    wsSource.Range("AH2").Value = .Range("U15")
                   
                    'Access Overside
                    wsSource.Range("AI2").Value = .Range("Y15")
                   
                    'Area Class 0
                    wsSource.Range("AK2").Value = .Range("F17")
                   
                    'Area Class 1
                    wsSource.Range("AL2").Value = .Range("F18")
                   
                    'Area Class 2
                    wsSource.Range("AM2").Value = .Range("F19")
                   
                    'Area Class Safe
                    wsSource.Range("AN2").Value = .Range("F20")
                   
                    'Ignition Risk H
                    wsSource.Range("AP2").Value = .Range("J17")
                   
                    'Ignition Risk m
                    wsSource.Range("AQ2").Value = .Range("J18")
                   
                    'Ignition Risk L
                    wsSource.Range("AR2").Value = .Range("J19")
                   
                    'Enviroment S
                    wsSource.Range("AT2").Value = .Range("N17")
                   
                    'Enviroment m
                    wsSource.Range("AU2").Value = .Range("N18")
                   
                    'Enviroment b
                    wsSource.Range("AV2").Value = .Range("N19")
                   
                    'corrosion h
                    wsSource.Range("AX2").Value = .Range("R17")
                   
                    'corrosion m
                    wsSource.Range("AY2").Value = .Range("R18")
                   
                    'corrosion l
                    wsSource.Range("AZ2").Value = .Range("R19")
                   
                    'vibration h
                    wsSource.Range("BB2").Value = .Range("V17")
                   
                    'vibration m
                    wsSource.Range("BC2").Value = .Range("V18")
                   
                    'vibration l
                    wsSource.Range("BD2").Value = .Range("V19")
                   
                    'inspection date
                    wsSource.Range("BF2").Value = .Range("L151")
                   
                    'grade of inspection
                    wsSource.Range("BG2").Value = .Range("W24")
                   
                    'inspected by
                    wsSource.Range("BJ2").Value = .Range("L154")
                End With
           
                'close inspection sheet
                wbTarget.Close
            Next i
        End If
    End With
End Sub

---

Thanks again, one last thing...

Despite all my attempts, I can't quite work out how I would go about making a new row appear in wsSource after the copy/paste action for one sheet is completed.

I have tried using

Code:

---

'select sheet1 and create new line for next copy/paste
Sheets("Sheet1").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

---

but it comes back with subscript out of range... Any suggestions?

If you are going to copy/paste each file to a new area, you will need a lot more than that, you have a whole raft of fields to copy over, and you would need to index all of the target cells. Is it your wish to copy file 1 to rows 20-100 (just an example, not necessarily the actual rows), file 2 to 120-200, file 3 to 220-300, and so on?