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