Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 59
Default How to alter the code to copy to the same exact cell destination?

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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 59
Default How to alter the code to copy to the same exact cell destination?

Anyone any suggestion?


"Adnan" wrote:

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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
copy an exact formula without changing cell reference Vidal Excel Worksheet Functions 1 September 5th 09 09:48 AM
Code to Alter value by adding 1 to value in cell 4 rows above Corey Excel Programming 5 November 28th 06 03:34 AM
Copy every 3rd cell, define destination range for paste Meltad Excel Programming 1 September 27th 06 01:46 PM
Copy Destination:= Code Stops Here Robert Christie[_3_] Excel Programming 3 January 26th 05 05:46 PM
Copy an exact cell value (text) Rasmus[_2_] Excel Programming 1 September 12th 04 12:15 PM


All times are GMT +1. The time now is 06:51 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"