I've trying to do the following and got stuck while doing so.
What I want to achieve:
- Search for a certain text/value in a range of headers of various worksheets (the certain text/value from a different worksheet "DB")
- When a header with that value is found, copy all the data below that header and paste it as a value in that same column
- AND, copy the formula that is 1 column to the right of column with matched header and 'paste formula' to the last row of a certain column of that corresponding worksheet(e.g., if header with the value is found on H11, copy the formula of I12 and paste upto last row of A in column I)
- Repeat this for all headers in the range of various worksheets
I searched various sources to come up with the below code.
Code I have so far:
Dim Lr1,lr2,lr3,lr4 As Long
Dim rng, c, rngAddress As Range
Dim period As String
period = Worksheets("DB").Range("Y1")
Lastrow1 = Worksheets("Calc_1").Cells(Rows.Count, "A").End(xlUp).Row
Lastrow2 = Worksheets("Calc_2").Cells(Rows.Count, "A").End(xlUp).Row
Lastrow3 = Worksheets("Calc_3").Cells(Rows.Count, "A").End(xlUp).Row
Lastrow4 = Worksheets("Calc_4").Cells(Rows.Count, "A").End(xlUp).Row
With Worksheets("Calc_1", "Calc_2", "Calc_3", "Calc_4")
Set rng = Activesheet.Range("G11:Z11")
For Each c In rng
If c = period Then
Range(c, c.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'cannot figure out the column to the right aspect here
Else
End If
Next
End With
The vba doesn't run and I have a hard time figuring out the full code to achieve my goal. Would appreciate any help!
This is what I have after editing:
Dim period As String
Dim ws As Worksheet
Dim rng As Range
period = Worksheets("Model_DB").Range("Y1")
Lastrow1 = Worksheets("Calc_1").Range("A" & .Rows.Count).End(xlUp).Row
Lastrow2 = Worksheets("Calc_2").Range("A" & .Rows.Count).End(xlUp).Row
Lastrow3 = Worksheets("Calc_3").Range("A" & .Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Sheets
Select Case ws.Name
Case "Calc_1", "Calc_2", "Calc_3"
With ws
For Each rng In .Range("G11:Z11")
If rng.Value = period Then
'/change to value/
Range(rng).Select.Copy
Range(rng & Lastrow1).Paste Special=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'/put formula on the right column/
fn.Offset(1, 1).Copy
Range(rng & Lastrow1).Paste Special=xlPasteformulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Exit For
End If
Next rng
End With
End Select
Next ws
xlDown
in such scenario but what you are trying to achieve can be done in one line rather than copying and paste special....Columns(C.Column).Value = .Columns(C.Column).Value
– Siddharth Rout