How to alter the code to copy to the same exact cell destination?

[Adnan]

Hi all,

I do not quite understand this. When this code runs, it copies values and
formulas from one workbook to another. The issue is that some of the rows in
source workbook are hidden and what this codes does copies but not to the
same cell in the destination workbook.

i.e:
Source Workbook
A B
1 Text1 10
2 Text2 [has a formula C2+E2]
3 [this row is blank therefore hidden]
4 Text3 [has a formula C4+E4]

Destination Workbook
A B
1 Text1 10
2 Text2 [has a formula C2+E2]
4 Text3 [has a formula C4+E4] <----------- this is the issue I am
referring to. It should have been C3+C3
3 [this row is blank therefore hidden]

So, what do I need to alter in following code to remove this error?


Sub Data_Sheet(PE As Workbook, Template As Workbook)

Dim PEStartRow As Long
Dim TemplateAddress As Range
Dim PC As Long
Dim Dell As Long
Dim i, s, l, p, d, sr, w, b As Long
Dim EWRow As Range
Dim PERow As Range


s = 44
p = 40
sr = 204

Application.Calculation = xlCalculationManual

PEStartRow = Empty
PE.Worksheets("Sheet1").Activate

For i = 8 To 15
If Cells(i, 1).Value Like "*Site*" Then
PEStartRow = i + 1
Exit For
End If
Next i

Template.Worksheets("Sheet1").Cells(12, 1).Value =
PE.Worksheets("Sheet1").Cells(PEStartRow, 1).Value

For n = PEStartRow + 10 To 280
If Cells(n, 6).Value = "" And Cells(n + 1, 1).Value <> "" Then
Template.Worksheets("Sheet1").Cells(s, 1).Value =
PE.Worksheets("Sheet1").Cells(n + 1, 1).Value
s = s + 32
End If
Next n


For l = 12 To 300
d = p + 2

If PE.Worksheets("Sheet1").Cells(l, 6).Value Like "*PC MODEL
DEVICE*" Then
PC = Cells(l, 3).Value
Template.Worksheets("Sheet1").Cells(p, 3).Value = PC
ElseIf PE.Worksheets("Sheet1").Cells(l, 6).Value Like "*DELL
POWEREDGE*" Then
Dell = Cells(l, 3).Value
Template.Worksheets("Sheet1").Cells(d, 3).Value = Dell
p = p + 32
End If
Next l

For w = 12 To 300
Set EWRow = Template.Worksheets("Sheet1").Cells(sr, 1)
If PE.Worksheets("Sheet1").Rows(w).EntireRow.Hidden = False
Then

If Cells(w, 2).Value <> "11" And Cells(w, 2).Value <> "12"
And Cells(w, 2).Value <> "13" And Cells(w, 2).Value <> "37" Then
Set PERow = PE.Worksheets("Sheet1").Cells(w, 1)
For b = 0 To 20
EWRow.Offset(0, b).Value = PERow.Offset(0,
b).Value
EWRow.Offset(0, b).Formula = PERow.Offset(0,
b).Formula
Next b
End If

sr = sr + 1
End If
Next w

Set PEETCCell = PE.Worksheets("Sheet1").Cells(2, 22)
Set TemplateETCCell = Template.Worksheets("Sheet1").Cells(2, 22)

For m = 0 To 5
TemplateETCCell.Offset(m, 0).Value =
PEETCCell.Offset(m, 0).Value
Next m

End Sub

Translatting it as what it does would also be a great help.

I appreciate any help provided,
Adnan

 

[Adnan]

Anyone any suggestion?