Insert a column value to another sheet

[Tharabai]

Hi,

I have inserted a two columns (column F and G) in sheet 2. The values in sheet2 to be filled in columns A and C of sheet3. I have the coding which required little tweaking.

Some one help me on this pls.. its very urgent !!!

Sub Demo2()
  Const FR = 6
  Dim Rg As Range
  Set Rg = Sheet1.[B4].CurrentRegion
  R& = FR
With Sheet3
  Application.ScreenUpdating = False
  .Cells(R, 1).CurrentRegion.Offset(1).ClearContents
  With .Cells(157).CurrentRegion.Columns
  If .Count Mod 2 Then Set Rg = Nothing: Beep: Exit Sub
  F$ = "SUBTOTAL(103," & Rg.Columns(1).Address(, , , True) & ")-1"
  va = [{1,2,4,0;2,3,17,16}]
  For C& = 1 To .Count Step 2
  V = Application.Match(.Cells(C).Value, Rg.Rows(1), 0)
  If IsNumeric(V) Then
  Rg.AdvancedFilter xlFilterInPlace, .Cells(C).Resize(2, 2)
  N& = Evaluate(F)
  If N Then
  va(1, 4) = V
  For K& = 1 To 4
  With Rg.Columns(va(1, K)).Offset(1)
  .Copy:  Sheet3.Cells(R, va(2, K)).PasteSpecial xlPasteValues
  If K = 4 Then .Font.ColorIndex = 3
  End With
  Next
  Sheet3.Cells(R, 15).Resize(N).Value = .Cells(C).Value
  R = R + N
  End If
  End If
  Next
  End With
  H$ = "=VLOOKUP($B" & FR & "," & .Cells(153).CurrentRegion.Address & ",2+(COLUMN()=9),FALSE)"
  va = [{1,4,5,7,11,12,13;6,"No","Contractor",1,1,0,0}]
  va(2, 6) = DateAdd("m", 1, .[K3].Value)
 
  With .Cells(4, 157).CurrentRegion
  Set Rg = .Rows(1):  F = "=VLOOKUP(""?""," & .Address(, , , True) & ",¤,FALSE)"
  End With
  With .Cells(FR, 1).CurrentRegion.Rows
  With .Item("2:" & .Count).Columns
  For C = 1 To 6:  .Item(va(1, C)).Value = va(2, C):  Next
  .Item(3).NumberFormat = """Tower ""@"
  va = .Item(15).Value:  V = .Item(2).Value
  For R = 1 To UBound(V)
  V(R, 1) = Evaluate(Replace(Replace(F, "?", V(R, 1)), "¤", Application.Match(va(R, 1), Rg, 0)))
  Next
  .Item(6).Value = V
  With .Item("H:I"):  .Formula = H:  .Formula = .Value:  End With
  For R = 1 To UBound(va)
  va(R, 1) = IIf(Not (IsNumeric(va(R, 1))), "Replacing " & va(R, 1), "Replacing Contactor")
  Next
  .Item(10).Value = va
  End With
  End With
  Application.Goto .Cells(1), True
End With
  Set Rg = Nothing:  If Sheet1.FilterMode Then Sheet1.ShowAllData

The below coding to be changed

F$ = "SUBTOTAL(103," & Rg.Columns(1).Address(, , , True) & ")-1"
  va = [{1,2,4,0;2,3,17,16}]

   With .Cells(FR, 1).CurrentRegion.Rows
  With .Item("2:" & .Count).Columns
  For C = 1 To 6:  .Item(va(1, C)).Value = va(2, C):  Next
  .Item(3).NumberFormat = """Tower ""@"
  va = .Item(15).Value:  V = .Item(2).Value
  For R = 1 To UBound(V)
  V(R, 1) = Evaluate(Replace(Replace(F, "?", V(R, 1)), "¤", Application.Match(va(R, 1), Rg, 0)))
  Next
  .Item(6).Value = V
  With .Item("H:I"):  .Formula = H:  .Formula = .Value:  End With
  For R = 1 To UBound(va)
  va(R, 1) = IIf(Not (IsNumeric(va(R, 1))), "Replacing " & va(R, 1), "Replacing Contactor")
  Next
  .Item(10).Value = va
  End With
  End With

 

[Tharabai]

I have attached the sample spreadsheet for reference.
The columns highlighted in yellow to be changed in sheet3

 

[Nebu]

Hi:

Couple of things while posting a random code snippet

• Explain what the code does.
• What is your expected result.( we are not expert in your business process)
• What is the error you are getting, if at all you are getting one ( we are doing this for free, do not expect us to do all the research for you). BTW, the macro is running fine without any errors.

I am sure you have copied this code from somewhere, if you can explain what you want to achieve here and what is your expected result.This can be achieved with a much simpler code I guess.( again I am not promising this, since you never gave us any info other than just asking to fix some random code).

Thanks