VBA to loop through list of names

[kira023]

Hi

I'm having an issue the macro that I'm creating. I'm trying to loop through the list of names on the CONSOLIDATED file which should start on B10 and would input data to Template file then save the file. It's working but for some reason it's skipping names and only doing 9 files and not going through the list of names. Please help me fix the issue.

Sub OpenWorkbook()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet

Dim FileName As String
Dim newFileName As String
Dim StName As String
FileName = "ICT-SF9-SF10-B1-Template.xlsx"


'Open a workbook
  'Open method requires full file path to be referenced.
    Workbooks.Open "C:\Users\cj\Desktop\TEST\" & FileName
  
    Set wsCopy = Workbooks("CONSOLIDATED.xlsm").Worksheets("Sheet1")
    Set wsDest = Workbooks("Template.xlsx").Worksheets("SF 9 FRONT")

  
  'Open method has additional parameters

    For i = 11 To Columns.Count
   
        If Range("A" & i).Value <> "" Then
            'Copy & Paste Data
                wsCopy.Range("C" & i).Copy
                wsDest.Range("Q10").PasteSpecial xlPasteValues
              
                StName = wsCopy.Range("C" & i).Value
        
                wsCopy.Range("E" & i).Copy
                wsDest.Range("P11").PasteSpecial xlPasteValues
              
                wsCopy.Range("B" & i).Copy
                wsDest.Range("S14").PasteSpecial xlPasteValues
                
                newFileName = "C:\Users\cj\Desktop\TEST\ICT-SF9-SF10-B1-" & StName & ".xlsx"
                ActiveWorkbook.SaveAs FileName:=newFileName
                Else
            End If
    
    Next
End Sub

 

[Fluff]

Maybe

Sub OpenWorkbook()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet

Dim FileName As String
Dim newFileName As String
Dim StName As String
FileName = "ICT-SF9-SF10-B1-Template.xlsx"


'Open a workbook
  'Open method requires full file path to be referenced.
    Workbooks.Open "C:\Users\cj\Desktop\TEST\" & FileName
  
    Set wsCopy = Workbooks("CONSOLIDATED.xlsm").Worksheets("Sheet1")
    Set wsDest = Workbooks("Template.xlsx").Worksheets("SF 9 FRONT")

  
  'Open method has additional parameters

    For i = 10 To wsCopy.Range("B" & Rows.Count).End(xlUp).Row
   
        If wsCopy.Range("B" & i).Value <> "" Then
            'Copy & Paste Data
                wsCopy.Range("C" & i).Copy
                wsDest.Range("Q10").PasteSpecial xlPasteValues
              
                StName = wsCopy.Range("C" & i).Value
        
                wsCopy.Range("E" & i).Copy
                wsDest.Range("P11").PasteSpecial xlPasteValues
              
                wsCopy.Range("B" & i).Copy
                wsDest.Range("S14").PasteSpecial xlPasteValues
                
                newFileName = "C:\Users\cj\Desktop\TEST\ICT-SF9-SF10-B1-" & StName & ".xlsx"
                wsDest.SaveAs FileName:=newFileName
                Else
            End If
    
    Next
End Sub

 

[kira023]

WOW That worked!Thank you so much!

I have another question. If in Column B the list of names are seperated by Male and Female how can I add a condition to put Male or Female on a specific cell on the new file created?

Maybe

Sub OpenWorkbook()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet

Dim FileName As String
Dim newFileName As String
Dim StName As String
FileName = "ICT-SF9-SF10-B1-Template.xlsx"


'Open a workbook
  'Open method requires full file path to be referenced.
    Workbooks.Open "C:\Users\cj\Desktop\TEST\" & FileName
 
    Set wsCopy = Workbooks("CONSOLIDATED.xlsm").Worksheets("Sheet1")
    Set wsDest = Workbooks("Template.xlsx").Worksheets("SF 9 FRONT")

 
  'Open method has additional parameters

    For i = 10 To wsCopy.Range("B" & Rows.Count).End(xlUp).Row
  
        If wsCopy.Range("B" & i).Value <> "" Then
            'Copy & Paste Data
                wsCopy.Range("C" & i).Copy
                wsDest.Range("Q10").PasteSpecial xlPasteValues
             
                StName = wsCopy.Range("C" & i).Value
       
                wsCopy.Range("E" & i).Copy
                wsDest.Range("P11").PasteSpecial xlPasteValues
             
                wsCopy.Range("B" & i).Copy
                wsDest.Range("S14").PasteSpecial xlPasteValues
               
                newFileName = "C:\Users\cj\Desktop\TEST\ICT-SF9-SF10-B1-" & StName & ".xlsx"
                wsDest.SaveAs FileName:=newFileName
                Else
            End If
   
    Next
End Sub

 

[Fluff]

You would be better off putting the Male/Female into another cell along side their name & then refer to that.

 

[kira023]

Ok Thank you so much!

 

[Fluff]

You're welcome & thanks for the feedback.