Geek Answers Handbook

EXCEL VBA, insert blank lines and toggle cells

I am having trouble entering the entire empty string. I am trying to move A-AD columns (four columns beyond Z).

AO cells currently have content. O-AD cells are empty. But I run a macro to put the data to the right of the current data (column O).

I can insert a row using

dfind1.Offset(1).EntireRow.Insert shift:=xlDown

but it only seems to be offset down from the AO. I managed to shift O-AD with a for loop

 dfind1 as Range For d = 1 To 15 dfind1.Offset(2, (d + 14)).Insert shift:=xlDown Next d

Is there a way to offset 30 VS 15 cells? Similarly, I want to translate 15 into cells on the right. I currently have another loop setting for this.

As for the rest of the code, below. Basically merging two excel databases to find a match in column A. I noted a problem area. The rest of the code works for the most part.

 Sub combiner() Dim c As Range, d As Long, cfind As Range, x, y, zed, dest As Range, cfind1 As Range, dfind As Range, _ dfind1 As Range, crow, x_temp, y_temp On Error Resume Next Worksheets("sheet3").Cells.Clear With Worksheets("sheet1") .UsedRange.Copy Worksheets("sheet3").Range("a1") End With With Worksheets("sheet2") For Each c In Range(.Range("a3"), .Range("a3").End(xlDown)) x = c.Value y = c.Next Set cfind = .Cells.Find(what:=y, lookat:=xlWhole) .Range(cfind.Offset(0, -1), cfind.End(xlToRight)).Copy With Worksheets("sheet3") Set dfind1 = .Cells.Find(what:=x, lookat:=xlWhole) If dfind1 Is Nothing Then GoTo copyrev '************************************************************** '************************************************************** 'This is the problem Area 'I'm basically having trouble inserting a blank row dfind1.Offset(1).EntireRow.Insert shift:=xlDown For d = 1 To 15 dfind1.Offset(1).Insert shift:=xlToRight Next d For d = 1 To 15 dfind1.Offset(2, (d + 14)).Insert shift:=xlDown Next d '************************************************************** '************************************************************** End With 'sheet3 GoTo nextstep copyrev: With Worksheets("sheet3") x_temp = .Cells(Rows.Count, "A").End(xlUp).Row y_temp = .Cells(Rows.Count, "P").End(xlUp).Row If y_temp > x_temp Then GoTo lr_ed lMaxRows = x_temp GoTo lrcont lr_ed: lMaxRows = y_temp lrcont: .Range(("P" & lMaxRows + 1)).PasteSpecial Worksheets("sheet2").Range(cfind.Offset(0, -1), cfind.Offset(0, 0)).Copy .Range(("A" & lMaxRows + 1)).PasteSpecial End With 'sheet3 nextstep: Next lngLast = Range("A" & Rows.Count).End(xlUp).Row With Worksheets("Sheet3").Sort .SortFields.Clear .SortFields.Add Key:=Range("A1:A2" & lngLast), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("B3:Z" & lngLast) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With 'sheet2 Application.CutCopyMode = False End Sub
+9
source share
2 answers

If you want to just shift everything, you can use:

 Rows(1).Insert shift:=xlShiftDown

Similarly shift everything:

 Columns(1).Insert shift:=xlShiftRight
+28
source 
 Sub Addrisk() Dim rActive As Range Dim Count_Id_Column as long Set rActive = ActiveCell Application.ScreenUpdating = False with thisworkbook.sheets(1) 'change to "sheetname" or sheetindex for i = 1 to .range("A1045783").end(xlup).row if 'something' = 'something' then .range("A" & i).EntireRow.Copy 'add thisworkbook.sheets(index_of_sheet) if you copy from another sheet .range("A" & i).entirerow.insert shift:= xldown 'insert and shift down, can also use xlup .range("A" & i + 1).EntireRow.paste 'paste is all, all other defs are less. 'change I to move on to next row (will get + 1 end of iteration) i = i + 1 end if On Error Resume Next .SpecialCells(xlCellTypeConstants).ClearContents On Error GoTo 0 End With next i End With Application.CutCopyMode = False Application.ScreenUpdating = True 're-enable screen updates End Sub
+1
source

More articles:


All Articles