Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
copy an exact formula without changing cell reference | Excel Worksheet Functions | |||
Code to Alter value by adding 1 to value in cell 4 rows above | Excel Programming | |||
Copy every 3rd cell, define destination range for paste | Excel Programming | |||
Copy Destination:= Code Stops Here | Excel Programming | |||
Copy an exact cell value (text) | Excel Programming |