VBA copy row multiple times based on cell value and change cell value in copied rows

[secretsqrl]

Hello,
I'm a VBA novice and normally can cobble something together based upon some of the fantastic work on this forum, but I have a complex issue that has multiple elements that I'm having a difficult time getting my head around.

I have a master worksheet that has 200 rows and looking for a script that can do the following:
1. Evaluate each row and copy the row x number of times into a new sheet based upon the information in Location column
a. If the Location is a single city then only copy the row once
b. If the Location is Global then the row needs to be copied 11 times representing all locations changing the location from Global to each of the 11 cities
2. When the location is Global, once all 11 rows have been copied and changed to each of the locations I also need to split the total cost(Column C) based on a percentage for each location. it will total 100% but will be different for each location and need the ability to change the values in the script as it could change over time.

Simple example: Master Spreadsheet

New worksheet with copied rows and changed values.

Any assitance would be greaty appreciated.

 

[DanteAmor]

Try this:

Sub CopyRows()
  Dim shR As Worksheet
  Dim i As Long
  Dim c As Range
  Dim x As Double
  
  Set shR = Sheets("Result")
  With Sheets("Master")
    For i = 2 To .Range("A" & Rows.Count).End(3).Row
      If .Range("D" & i).Value = "Global" Then
        For Each c In .Range("G2:G12")
          x = .Range("C" & i).Value * c.Offset(, 1).Value
          shR.Range("A" & Rows.Count).End(3)(2).Resize(1, 4).Value = Array(.Range("A" & i), .Range("B" & i), x, c)
        Next
      Else
        shR.Range("A" & Rows.Count).End(3)(2).Resize(1, 4).Value = .Range("A" & i).Resize(1, 4).Value
      End If
    Next
  End With
End Sub

 

[secretsqrl]

Try this:

Sub CopyRows()
  Dim shR As Worksheet
  Dim i As Long
  Dim c As Range
  Dim x As Double
 
  Set shR = Sheets("Result")
  With Sheets("Master")
    For i = 2 To .Range("A" & Rows.Count).End(3).Row
      If .Range("D" & i).Value = "Global" Then
        For Each c In .Range("G2:G12")
          x = .Range("C" & i).Value * c.Offset(, 1).Value
          shR.Range("A" & Rows.Count).End(3)(2).Resize(1, 4).Value = Array(.Range("A" & i), .Range("B" & i), x, c)
        Next
      Else
        shR.Range("A" & Rows.Count).End(3)(2).Resize(1, 4).Value = .Range("A" & i).Resize(1, 4).Value
      End If
    Next
  End With
End Sub

WOW! WOW! WOW!
Many thanks @DanteAmor ...this is exactly what I was after. I've scaled it to the actual size of my worksheet and works like a charm

Can't thank you enough as you've saved me lots of work!!!!!

 

[DanteAmor]

Im glad to help you. Thanks for the feedback