Excel vba - paste below header - vba

I need to copy a column from one workbook to another.
y.Sheets("data").Range("A2:A1048576").Clear 'delete contents of target columns first
x.Sheets("file").Range("C:C").Copy 'copy column from another sheet
y.Sheets("data").Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
I'm trying to paste it to starting from A2 since A1 is my header.
I'm getting a application-defined or object-defined error

It's best practice not to reference entire columns (some million cells) when you don't need to:
With y.Sheets("data") ' reference sheet "data" in workbook 'y'
.Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).ClearContents ' clear 'referenced sheet column "A" cells from row 2 down to last not empty one
End With
With x.Sheets("file") ' reference sheet "file" in workbook 'x'
With .Range("C1", .Cells(.Rows.Count, "C").End(xlUp)) 'reference referenced sheet column "C" cells from row 1 down to last not empty one
y.Sheets("data").Range("A2").Resize(.Rows.Count).Value = .Value ' paste referenced range values to workbook "y" sheet "data" starting from cell A2
End With
End With

Or the following
With y.Sheets("data")
Intersect(.UsedRange, .Columns("A")).Clear
Intersect(x.Sheets("file").UsedRange, x.Sheets("file").Columns("C")).Copy .Range("A2")
End With

The issue here is you copy a complete column Range("C:C").Copy and that means you have to paste to a complete column otherwise it would not fit in and exceed Excel's maximum row count.
Therefore I suggest to copy only that part of column C that contains data:
With x.Sheets("file")
.Range("C1", .Cells(.Rows.Count, "C").End(xlUp)).Copy
End With
This copies only from C1 to the last used cell. And then you can paste it directly to A2
y.Sheets("data").Range("A2").PasteSpecial xlPasteValues

Related

Excel VBA formula's not updating row

So my code is to insert a row, copy its format from the previous row, and then insert the formulas that I have preset on a different row. So lets say I insert a new row, row 11, the formula should copy row 10's formats and insert the formulas from row 44 (which I designated as my formula row).
Now, the formulas will all reference row 10 instead of row 11. I'm not sure why that is.
Here is my code:
Dim i As Integer
'loop through position sheets and insert blank rows
For i = 1 To 4
Sheets(i).Select
Rows(row_to_insert).EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next i
'loop through sheets and copy/paste formulas into new rows
For i = 1 To 4
Sheets(i).Select
Rows(blank_row_to_use + 1).EntireRow.Select
Selection.Copy
Rows(row_to_insert).EntireRow.Select
ActiveSheet.Paste
Next I
End Sub
This worked fine until I added a new sheet, and expanded from For i = 1 To 3 to For i = 1 to 4.
Any ideas why it suddenly stopped working?
the issue lays in those relative references to another sheet that don't get updated by any rows shifts taking place in the sheet where they are used
while they'd get updated if you shifted rows in the sheet they are referencing
so you have to play a little bit with relative /absolute references to mimic some referenced sheet rows shifting, but without doing it!
for instance you could use a Function that converts some range formulas to absolute or relative reference type, like the following:
Sub Convert(rng As Range, toReferenceType As XlReferenceType)
Dim cell As Range
For Each cell In rng.SpecialCells(XlCellType.xlCellTypeFormulas) ' loop thorugh passed range relevant cells (i.e. those containing formulas)
If InStr(cell.Formula, "!") > 0 Then cell.Formula = Application.ConvertFormula(cell.Formula, xlA1, xlA1, toReferenceType) ' if current cell has an explicit sheet reference, then convert its formula to the passed reference type
Next
End Sub
and the use it in your code
For i = 1 To 1
With ThisWorkbook.Sheets(i)
.Rows(blank_row_to_use).Copy .Rows(blank_row_to_use + 1) ' copy formulas "template" row one "helper" row below
Convert .Rows(blank_row_to_use + 1), xlAbsolute ' convert "helper" row formulas with some explicit sheet reference to absolute type so they don't get updated by any subsequent row shift
.Rows(blank_row_to_use + 1).Copy .Rows(blank_row_to_use) ' copy "helper" row converted formulas and paste them back to formula "template" row -> now you have a formula with an absolute row reference one below its own row
.Rows(blank_row_to_use + 1).ClearContents ' clear "helper" row
.Rows(row_to_insert).Insert Shift:=xlDown, opyOrigin:=xlFormatFromLeftOrAbove ' insert new row -> formulas "template" row references don't get updated and now you have a formula with an absolute row reference to its own row
Convert .Rows(blank_row_to_use + 1), xlRelative ' convert formulas "template" row formulas with some explicit sheet reference to relative type so they do get updated by any subsequent row shift
.Rows(row_to_insert).EntireRow.Formula = .Rows(blank_row_to_use + 1).EntireRow.Formula ' copy formulas "template" row formulas row to the new row and have them updated
End With
Next
Please note also that
.Rows(row_to_insert).EntireRow.Formula = .Rows(blank_row_to_use + 1).EntireRow.Formula
is better than any Copy and subsequent PasteSpecial approach in that it doesn't use the clipboard
Try the much shorter and cleaner version of what you are trying to achieve.
Note: try to avoid using Select, Selection and ActiveSheet, and use fully qualified Sheet objects.
Modified Code
'loop through position sheets and insert blank rows
For i = 1 To 4
With ThisWorkbook.Sheets(i)
.Rows(row_to_insert).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows(blank_row_to_use + 1).EntireRow.Copy
.Rows(row_to_insert).EntireRow.PasteSpecial xlPasteFormulas
End With
Next i

Excel VBA: Copying/Pasting Range

I'm writing a macro that opens a number of different workbooks, copies data from each, and compiles into a single "master" workbook. In the below code example, wb2 is one of the workbooks and I'm copying from, and wb1 is the master.
lrow3A is the last row of data in the source workbook. Lrow3 is the last row of data in the master workbook.
lrow3A = wb2.Sheets("DCF3").Cells(1048576, 2).End(xlUp).Row
wb2.Sheets("DCF3").Range(Cells(6, 1), Cells(lrow3A, 16)).Copy _
Destination:=wb2.Worksheets("DCF3").Cells(lrow3 + 1, 2)
I'm getting a "Subscript out of range" error on the copy line.
I think you should code:
With wb2.Sheets("DCF3") 'reference "source" worksheet
lrow3A = .Cells(.Rows.Count, 2).End(xlUp).Row ' get referenced sheet column "B" last not empty cell row index
.Range("A6:P" & lrow3A).Copy _
Destination:=wb1.Worksheets("DCF3").Cells(lrow3 + 1, 2) 'copy referenced sheet range in columns A:P from row 6 to row 'lrow3A' and paste it to "master" workbook sheet "DCF3" starting from its column B cell at row 'lrow3'+1
End With

VBA code, If cells in a certain column contain a certain word in need to cut and paste the entire row on to a different sheet

I need VBA code for the following:
If cells in a certain column contain a certain word, I need to cut and paste the entire row onto a different sheet. I found some code, but it matches the row on the destination sheet. I just need it to go on to the different sheet and be deleted from the source.
Can anyone kindly advise?
if your "Column" has a header as its first cell then you can use AutoFilter() as per following code (see comments to adjust it to your actual needs)
Sub main()
With Worksheets("mySheetName") '<--| reference the worksheet with data (change "mySheetName" to your actual worksheet with data name
With .Range("A1", .Cells(.Rows.count, "A").End(xlUp)) '<--| reference its "column" (change "A" occurrences to your actual column with data index)
.AutoFilter Field:=1, Criteria1:="d" '<--| change "word" to your actual word to be looked for
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
With .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
.Copy Worksheets("myOtherSheetName").Range("A1")
Application.DisplayAlerts = False
.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
End With
End If
.AutoFilterMode = False
End With
End With
End Sub

Excel VBA insert row and copy data on multiple sheets

I am trying to get the correct VBA code that will allow me to insert a row in to a filtered table at the same place on multiple worksheets and copy all of the content from the entire row above.
There is a check box relating to each sheet in the workbook. If the check box is ticked then the row should be inserted in to this sheet.
The sheets are password protected. The password is found in another of the worksheets in the file.
I have almost got this to work. My file can be found at the following location:
https://drive.google.com/file/d/0B5HnHgSNFkFid0gwbDNMOFN1NUU/view?usp=sharing
The code is as follows:
Sub Insert_Rows()
Dim sh As Worksheet
For Each sh In Sheets
If sh.Name = "Sheet1" And Worksheets("Sheet4").Range("D1").Value = True Or _
sh.Name = "Sheet2" And Worksheets("Sheet4").Range("D2").Value = True Or _
sh.Name = "Sheet3" And Worksheets("Sheet4").Range("D3").Value = True Then
With sh
.Unprotect Password:=Worksheets("Sheet4").Range("A1")
.Cells(ActiveCell.Row, 4).EntireRow.Insert
.Range(.Cells(ActiveCell.Row, 1), .Cells(ActiveCell.Row, 4)).FillDown
.Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=Worksheets("Sheet4").Range("A1")
End With
End If
Next sh
End Sub
The issue I am having is that not all of the data from the row above is being copied. The data in the 5th column is not copying down. I am sure it is something to do with the 4 in the code .Cells(ActiveCell.Row, 4). I want it to copy the entire row above regardless of the number of columns.
Any help greatly appreciated.
Thanks
To FillDown the EntireRow, instead of just the Range between column 1 and column 4, replace
.Range(.Cells(ActiveCell.Row, 1), .Cells(ActiveCell.Row, 4)).FillDown
with
.Cells(ActiveCell.Row, 1).EntireRow.FillDown
(which could also be written as .Rows(ActiveCell.Row).FillDown)
Note:
Please remember that ActiveCell.Row is not necessarily referring to any special location on Sheet1, Sheet2, or Sheet3.
If the currently active cell is cell G67 on sheet Sheet4, then ActiveCell.Row will evaluate to 67 and so row 66 of Sheet1 (and/or Sheet2 and/or Sheet3) will be copied to a newly inserted row on Sheet1 (and/or Sheet2 and/or Sheet3) - it won't magically decide to insert row 58 on Sheet1 and row 82 on Sheet2, etc.
If the only problem you are having is that the entire row is not being filled down, then the solution above will fix it. But if you find that the wrong row is being filled down, then you will need to rethink how you are selecting the row.

VBA code in Excel to add a row to multiple sheets and then copy formula from adjacent row

I'm really hoping someone can help me with this one. I have recorded a macro to use within a sheet that needs to create a row at the same position on 2 worksheets and then, on one of them, copy the formula's in the cells from the row below it. The code I have looks like this -
Sub Macro1()
Sheets(Array("SCHEDULE", "ANNUAL SUMMARY")).Select
Sheets("SCHEDULE").Activate
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("ANNUAL SUMMARY").Select
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.AutoFill Destination:=ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow _
, Type:=xlFillDefault
ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow.Select
Sheets("SCHEDULE").Select
ActiveCell.Select
My problem is, when I run it manually and then record the macro, it does exactly what I want it to, but when I run this from a button on the "SCHEDULE" sheet it does not copy the formula's from the row below the one on the "ANNUAL SUMMARY" sheet.
Can anyone help to get this working with me?
Thanks all in advance
Mark
The problem with the macro recorder is that although it can give you a good indication of what code you need, it also generates very inefficient code and includes all of the select and activate statements that you need to try and avoid using.
Any reference in the code to ActiveCell is referring to the cell that is currently selected and ActiveSheet is the sheet that is currently selected. This can give you undesired results if you run the macro from a different sheet that the macro was recorded from...
If you wanted to copy row 1 from SCHEDULE sheet then you can use
Sheets("SCHEDULE").Rows(1).Copy Sheets("ANNUAL SUMMARY").Rows(1)
If you want to auto fill a range, then this can be accomplished with a single line of code
This will auto fill the contents of row1 (column A - E) down to row 100 in your ANNUAL SUMMARY sheet
Sheets("ANNUAL SUMMARY").Range("A1:E100").FillDown
So if we put it all together and include some declarations for our source and destination sheet to make the sub more readable..
Sub CopyAndFillDownExample()
Dim rowNumber As Long, offset As Long
Dim sourceSht As Worksheet, destinationSht As Worksheet
'set the source and destinationsheets
Set sourceSht = Sheets("SCHEDULE")
Set destinationSht = Sheets("ANNUAL SUMMARY")
'number of rows to copy down
offset = 100
'get currently selected row
rowNumber = ActiveCell.Row
'copy the selected row from the source sheet to the destination sheet
sourceSht.Rows(rowNumber).Copy destinationSht.Rows(rowNumber)
'fill down the formulas
destinationSht.Rows(rowNumber & ":" & rowNumber + offset).FillDown
End Sub