I'm trying to create a macro that copy and paste a dynamic range from a worksheet to another worksheet based on a label at the beginning of each row.
I have label on column "O" as 'ItemHeader', 'ItemInfo', 'ItemDesc' & 'ItemURL' and some information on each of these rows ending up on column "AE". SA have a defined width but I need to adjust each range based on its header on each row.
I need to find where each group of labels start and end to define my range and them copy and paste to another worksheet.
Each group of information such as 'ItemDesc' is together.
Me idea is to use the same macro on different worksheets as this template will be on the same column ("O:AE") but the number of rows will be vary.
Sheets("PBA220").Range("O3:AE3").Copy
Sheets("Carrinho").Visible = True
Sheets("Carrinho").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("PBA220").Range("O4:AB4").Copy
Sheets("Carrinho").Visible = True
Sheets("Carrinho").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("PBA220").Range("AC4:AE4").Copy
Sheets("Carrinho").Select
Range("A" & Rows.Count).End(xlUp).Offset(0, 14).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Sheets("PBA220").Range("O5:AE24").Copy
Sheets("Carrinho").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Sheets("PBA220").Range("O25:AE26").Copy
Sheets("Carrinho").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteAll
Thanks
enter image description here
You can use Find method from range. See MS documentation: https://learn.microsoft.com/en-us/office/vba/api/excel.range.find
Use it to find column start and end markers.
Related
I am building a macro to append new data to a master sheet. The code to select and copy the new data, then move to first free row of master sheet and paste new data works perfectly
Sheets("master").Select
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("new data").Select
Range("a2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("master").Select
Range("A" & lastrow).Select
ActiveSheet.Paste
I have a few columns I want to fill with a formula (for the demo, I put 0, actual formula differs) starting from its first empty cell all the way until the end of the sheet. The code to select the first cell of the range I want to fill and input the formula works fine
Range("C" & lastrow).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "0"
It looks like this:
Now I want to fill from that cell to column H until the last cell with that formula but I cant figure out how to select that dynamically. Static code below (recorded from macro):
Selection.AutoFill Destination:=Range("C31971:H40000" ), Type:=xlFillDefault
My current non working attempt (wont compile because syntax very wrong):
Selection.AutoFill Destination:=Range("C" & lastrow: "H" ), Type:=xlFillDefault
Range(Selection, Selection.End(xlDown)).Select
Desired result:
It seems one can not fill down and right at the same time, so two lines of code are needed.
I tried to fill to the end of the sheet. Excel crashed then, it is to much better to fill only some (hundred)thousand rows.
Range("C" & lastrow).AutoFill Destination:=Range("C" & lastrow & ":" & "H" & lastrow), Type:=xlFillDefault
Range("C" & lastrow & ":" & "H" & lastrow).AutoFill Destination:=Range("C" & lastrow & ":" & "H40000"), Type:=xlFillDefault
All,
I would greatly appreciate if someone could assist me with my VBA code Macro. I have 2 different Macros and I need to combine them AND alter one.
Im inserting a row via Excel at the bottom of the Table ABOVE my "Total Row". That works fine!!!
Sub InsertingRow()
Range("A" & Rows.Count).End(xlUp).Select
ActiveCell.EntireRow.Insert
End Sub
Then:
Sub Macro1()
'
' Macro1 Macro
'
'
Range("F12:O12").Select
Selection.Copy
Range("F13").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
**I need to combine the 2 Macros, but I need the PasteSpecial Macro to increment down with the Insert Row Macro and keep the specific columns/cells its copying too as well.
I have a "Total Row" so I need it to push the Total row down and insert/copy in the one above it.
Im sure this is easy.**
Thanks for all the replies.
Something like this should get you on the right track. I am not sure where your data needs to be copied from but give this a try and you will see how it works.
Sub Test()
Dim lastRow As Integer
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Rows(lastRow).Insert
Range("F" & lastRow - 1 & ":O" & lastRow - 1).Copy
Range("F" & lastRow).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
I have a code that involves a Drag Down Formula (FillDown). After the VLOOKUP is done, the FillDown method works well if there are 2 or more rows with values in it. But, I can't seem to understand why if there is only one row with values in it, the FillDown method does not work properly. It brings down the value of the first row (Header) instead and replaces the value. You may look at the picture I attached to see what I meant. After VLOOKUP, the rows should show the values as can be seen in the second picture I attached.
Workbooks("Data.xlsx").Activate
'COPY PASTE POSITIVE BARCODES
lastrow = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("A2:A" & lastrow).Copy
Workbooks("SIMKA CT VALUE FORMULA.xlsx").Activate
Sheets("Sheet3").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'APPLICATION OF LOOKUP FORMULA
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(LOOKUP(2,1/('[Data.xlsx]Sheet2'!C1=RC1)/('[Data.xlsx]Sheet2'!C15=R1C),('[Data.xlsx]Sheet2'!C16)),"""")"
Selection.AutoFill Destination:=Range("B2:F2"), Type:=xlFillDefault
Range("B2:F2").Select
Range("B2:F" & lastrow).FillDown
...
Selection.AutoFill Destination:=Range("B2:F2"), Type:=xlFillDefault
Range("B2:F2").Select
'FillDown isn't required for single row as it already has formulas
If lastrow > 2 Then Range("B2:F" & lastrow).FillDown
I have following code
First it will insert two columns one by one
Then count rows in C column
Then Copy ActiveCell.FormulaR1C1 = "=R[-5]C[18]" to B7 to rows count
Similarly, Copy ActiveCell.FormulaR1C1 = "=R[-5]C[13]" to A7 to rows count
But I am getting error when the Active Row is only 01 (One), if it is more than one then it works ok.
I am struggling with this. If anyone can please help.
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Dim LastRow As Long
LastRow = Range("C" & Rows.Count).End(xlUp).Row
Range("B7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-5]C[18]"
Range("B7").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("B7:B" & LastRow), Type:=xlFillCopy
Range("B7:B" & LastRow).Select
Range("A7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-5]C[13]"
Range("A7").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A7:A" & LastRow), Type:=xlFillCopy
Range("A7:A" & LastRow).Select
To close the question out:
Instead of using AutoFill, maybe do Range("B7:B" & LastRow).Value = Range("B7").Value, and similarly for column A.
Or just in one line for both columns: Range("A7:B" & LastRow).Value = Range("A7:B7").Value.
First off, the Selection object is not necessarily the best option. You can insert the columns with Range("A:B").Insert xlShiftToRight.
Next, you can set the formula for an entire range at once rather than copying and pasting. Since you're putting the formulas only starting at row 7, you'll need to offset and resize the range that is defined by what is in Column C (after the insert).
The Resize method will need to reduce the row count by 6 since the formulas don't start until row 7:.Resize(LastRow - 6). Since the original range is only one column wide, the column count in the Resize method can be omitted (otherwise, it'd be .Resize(LastRow - 6, 1)).
The Offset method will need to shift down 6 rows and left 1 (or 2) columns: .Offset(6,-1) and .Offset(6,-2)).
Your code would then be greatly simplified to:
Dim LastRow As Long
ActiveSheet.Range("A:B").Insert xlShiftToRight
LastRow = Range("C" & Rows.Count).End(xlUp).Row
With Range("C:C").Resize(LastRow-6)
.Offset(6,-1).FormulaR1C1="=R[-5]C[18]"
.Offset(6,-2).FormulaR1C1="=R[-5]C[13]"
End With
Of course, even easier would be to convert your sheet to a Table ("ListObject" in VBA) and let Excel do the heavy lifting. But that's way outside what you asked.
I have a sheet with a range of A12:N112, Column A is my trigger column (1 or ) based on changing criteria). The first bit of my macro which works sorts this range to all the rows with a 1 are at the top of the range. It then opens the destination sheet as well.
The next bit of code below, needs to copy cells B:L for each row with a 1 in column A and paste that into the first empty row in the destination sheet starting at column D. This then generates a number which the then copied and pasted back into the first sheet in column M of that specific row. This then needs to loop until all of the rows with a 1 in column A have been processed.
Can anyone help, here is my code, which runs but nothing is copied or pasted.
Dim lr As Long lr = Sheets("Data Entry").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step 1
If Range("AB" & r).Value = "1" Then
Rows(r).Copy.Range ("A" & lr2 + 1)
Windows("Serialisation Log.xlsx").Activate
Sheets("SNo Log").Select
Range("D" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("Serialisation Log.xlsx").Activate
Sheets("SNo Log").Select
Range("A" & Rows.Count).End(xlUp).Offset(-1).Select
Selection.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Range("A" & Rows.Count).End(xlUp).Offset(0).Select
Selection.Copy
Windows("Serialisation Generator rev 1.xlsm").Activate
Worksheets("Data Entry").Select
Range("N").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If Range("AB" & r).Value = "0" Then
Range("I4").Select
ActiveCell.FormulaR1C1 = "Serial No. Issue complete for this OA"
End If
Range("F5").Select
Next r
Any help will be greatly appreciated.