Reversing the process

[andytpl]

I have this macro (as shown) which basically pull in data from various worksheet with name starting with INF in the workbook to a worksheet called Summary. I now have a situation where I need to reverse the process and populate individual worksheet from the summary worksheet.
Wonder how can this be done. Please help.

Set wksSummary = Worksheets("Summary")

For i = 1 To Worksheets.Count

On Error Resume Next
Set wks = Worksheets("INF" & Format(i, "000"))
If Err <> 0 Then Exit For
On Error GoTo 0

With wks
wksSummary.Range("A" & i + 7).Value2 = .Range("B3").Value2
wksSummary.Range("B" & i + 7).Value2 = .Range("B10").Value2
wksSummary.Range("C" & i + 7).Value2 = .Range("B12").Value2
wksSummary.Range("D" & i + 7).Value2 = .Range("G3").Value2
wksSummary.Range("E" & i + 7).Value2 = .Range("K4").Value2
wksSummary.Range("F" & i + 7).Value2 = .Range("K5").Value2
wksSummary.Range("G" & i + 7).Value2 = .Range("k6").Value2
wksSummary.Range("H" & i + 7).Value2 = .Range("k7").Value2
wksSummary.Range("I" & i + 7).Value2 = .Range("I12").Value2
wksSummary.Range("J" & i + 7).Value2 = .Range("B14").Value2
wksSummary.Range("K" & i + 7).Value2 = .Range("G6").Value2
wksSummary.Range("L" & i + 7).Value2 = .Range("B4").Value2
wksSummary.Range("M" & i + 7).Value2 = .Range("C36").Value2
wksSummary.Range("N" & i + 7).Value2 = .Range("C27").Value2
wksSummary.Range("O" & i + 7).Value2 = .Range("K3").Value2
wksSummary.Range("P" & i + 7).Value2 = .Range("B1").Value2
wksSummary.Range("Q" & i + 7).Value2 = .Range("I14").Value2
wksSummary.Range("R" & i + 7).Value2 = .Range("M1").Value2
End With
Next i

Set wks = Nothing
Set wksSummary = Nothing

End Sub

[mdmackillop]

Use an array to store cell addresses; it makes manipulation easier. Only one line change is then required to restore the data.
This code is for the attached sample.

Option Explicit

Sub DoGet()
Dim wksSummary As Worksheet, wks As Worksheet
Dim i As Long, j As Long
Set wksSummary = Worksheets("Summary")
Dim Arr
Arr = Array("B3", "B10", "B12", "G3", "K4")
For i = 1 To Worksheets.Count
For j = 0 To UBound(Arr)
On Error Resume Next
Set wks = Worksheets("INF" & Format(i, "000"))
If Err <> 0 Then Exit For
On Error GoTo 0
wksSummary.Cells(i + 7, j + 1).Value2 = wks.Range(Arr(j)).Value2
Next j
Next i
Set wks = Nothing
Set wksSummary = Nothing
End Sub

Sub PutBack()
Dim wksSummary As Worksheet, wks As Worksheet
Dim i As Long, j As Long
Set wksSummary = Worksheets("Summary")
Dim Arr
Arr = Array("B3", "B10", "B12", "G3", "K4")
For i = 1 To Worksheets.Count
For j = 0 To UBound(Arr)
On Error Resume Next
Set wks = Worksheets("INF" & Format(i, "000"))
If Err <> 0 Then Exit For
On Error GoTo 0
wks.Range(Arr(j)).Value2 = wksSummary.Cells(i + 7, j + 1).Value2
Next j
Next i
Set wks = Nothing
Set wksSummary = Nothing
End Sub

[andytpl]

I was beginning to think what I asked may not be achievable, but you proof me wrong.

Thank you for your help and appreciate it truly.

[andytpl]

mdmackillop,

I have encountered an issue that I did not foresee earlier. Instead of pulling back all the data from every column of the summary sheet, Column 6 & 7 related to cell K6 & K7 of the individual worksheet will be skipped. The reason being these Columns in the individual sheet have formula in them that I do not want to write over.

Help greatly appreciated.

[andytpl]

mdmackillop,

One other question I meant to ask earlier but forgotten and that is, I have to declare every variables but I do not know what to declare Arr as, variant?

[mdmackillop]

Arr is Variant, which is the default if no specific type is specified.

[andytpl]

Mdmackillop,

Thanks!

My earlier question about skipping 2 columns in the summary sheet. Is that possible to be done?

[mdmackillop]

How about incorporating a Select statement.
Select Case j
Case 6, 7
'do nothing
Case Else
wks.Range(Arr(j)).Value2 = wksSummary.Cells(i + 7, j + 1).Value2
End Select

[andytpl]

Mdmackillop,

Somehow I always get an error statement. Below is the codes after your suggest changes but not too sure if it correct.

Sub PutBack()
Dim wksSummary As Worksheet, wks As Worksheet
Dim i As Long, j As Long
Set wksSummary = Worksheets("Summary")
Dim Arr As Variant
Arr = Array("B3", "B10", "B12", "G3", "K4", "K5", "I12", "B14", "G6", "B4", "C36", "C27", "K3", "B1", "I14", "M1")
For i = 1 To Worksheets.Count
For j = 0 To UBound(Arr)
On Error Resume Next
Set wks = Worksheets("INF" & Format(i, "000"))
If Err <> 0 Then Exit For
On Error GoTo 0
Select Case j
Case 7, 8
'do nothing
Case Else
wks.Range(Arr(j)).Value2 = wksSummary.Cells(i + 7, j + 1).Value2
End Select
Next j
Next i
Set wks = Nothing
Set wksSummary = Nothing
End Sub

[mdmackillop]

I don't get errors. Here's my sample file

[andytpl]

I found the reason for the problem. The worksheets are protected and this somehow caused the macro to run into error.
Now I just need the codes to unprotect and then protect those worksheets with name starting with INF. Any help in here are greatly appreciated. :yes

[andytpl]

Mdmackillop,

Solved the problem. The codes are as follows:

Thank you very much for all your help. :friends:

Sub PutBack()
Dim wksSummary As Worksheet, wks As Worksheet
Dim i As Long, j As Long
Set wksSummary = Worksheets("Summary")
Dim Arr As Variant
For Each wks In Sheets
If wks.Name Like "INF*" Then wks.Unprotect "andy"
Next
Arr = Array("B3", "B10", "B12", "G3", "K4", "K5", "K6", "K7", "I12", "B14", "G6", "B4", "C36", "C38", "K3", "B1", "I14", "M1")
For i = 1 To Worksheets.Count
For j = 0 To UBound(Arr)
On Error Resume Next
Set wks = Worksheets("INF" & Format(i, "000"))
If Err <> 0 Then Exit For
On Error GoTo 0
Select Case j
Case 6, 7, 12, 13
'Do nothing
wks.Range(Arr(j)).Interior.ColorIndex = 6
Case Else
wks.Range(Arr(j)).Value2 = wksSummary.Cells(i + 7, j + 1).Value2
End Select
Next j
Next i
Set wks = Nothing
Set wksSummary = Nothing
For Each wks In Sheets
If wks.Name Like "INF*" Then wks.Protect "andy"
Next
End Sub