I have to select specific row from so many rows and copy paste to another sheet but I don't want to specified value of cell if it takes value from particular cell
my code is
Sub Macro3()
Dim rngG As Range
Dim cell As Range
Sheets("Urban-Ward_vise").Select
Set rngG = Range("G1", Range("G65536").End(xlUp))
For Each cell In rngG
If cell.Value = "BAVLA" Then
cell.EntireRow.Copy
Sheets("Sheet1").Select
ActiveCell.Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next cell
Selection.End(xlUp).Select
End Sub
I want to select rows from Urban-Ward_vise and paste in sheet1
in
If cell.Value = "BAVLA" Then
I don't want put value "BAVLA" but I want to read the value from sheet1 cell like c5 so please help
Do you mean something like this?
It would be worth you reading how to avoid Select.
Sub Macro3()
Dim rngG As Range
Dim cell As Range
With Sheets("Urban-Ward_vise")
Set rngG = .Range("G1", .Range("G" & Rows.Count).End(xlUp))
End With
For Each cell In rngG
If cell.Value = Sheets("Sheet1").Range("C5").Value Then 'specify sheet name and cell here
cell.EntireRow.Copy
Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
End If
Next cell
End Sub
Related
I have the following to copy a range of free text boxes to another series of cells, which works as I want it to:
Public Sub LogEntry()
'define source range
Dim SourceRange As Range
Set SourceRange = ThisWorkbook.Worksheets("Log").Range("C4:J4")
'find next free cell in destination sheet
Dim NextFreeCell As Range
With ThisWorkbook.Worksheets("Log")
If IsEmpty(.Range("C8").Value) Then
Set NextFreeCell = .Range("C8")
Else
Set NextFreeCell = .Cells(.Rows.Count, "C").End(xlUp).Offset(1)
End If
End With
'copy & paste
SourceRange.Copy
NextFreeCell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
NextFreeCell.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'delete text box
ThisWorkbook.Save
Application.Goto Reference:="R4C7:R4C9"
Application.CutCopyMode = False
Selection.ClearContents
End Sub
In my original fields, in box J4, I have a drop down list. How do I copy this to the new location and maintain the list functionality? I also want to add conditional formatting to the selections in this box so would like this carried forward also?
If you copy (rather than Copy followed by PasteSpecial) a cell, the data validation will copy with it:
the code:
Sub KopyKat()
Dim J4 As Range, K5 As Range
Set J4 = Range("J4")
Set K5 = Range("K5")
J4.Copy K5
End Sub
the result:
So I'm trying to run a column through a table in Excel using VBA. I then want to copy the result and paste in another column. I've gotten it to work for one cell, however, when I try to loop the code, it just pastes the same thing in every cell in the range I want it to paste in. How do I make it so that when it loops, it only pastes in the single cell vs. the entire range? My code is below.
Sub Test1()
'
' Test1 Macro
'
'
Dim rng As Range, cell As Range
Set rng = Range("C16:C20")
For Each cell In rng
Dim rng2 As Range, cell2 As Range
Set rng2 = Range("G16:G20")
For Each cell2 In rng2
cell.Select
Selection.Copy
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D12").Select
Application.CutCopyMode = False
Selection.Copy
rng2.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Tranpose:=False
'ActiveCell.Offset(1, 0).Select
Next cell2
Next cell
End Sub
Thanks!
Guessing you want something like this:
Sub Test1()
Dim rng As Range, cell As Range, ws As Worksheet
Set ws = ActiveSheet
Set rng = ws.Range("C16:C20")
For Each cell In rng.Cells
ws.Range("B4").value = cell.Value
cell.offset(0, 4).value = ws.Range("D12").Value 'populate in Col G
Next cell
End Sub
Note there's typically no need to select/activate anything in excel (though the macro recorder does that a lot). Worth reviewing this: How to avoid using Select in Excel VBA
Likewise if you need to transfer values between cells you can do that directly without copy/paste.
The code below is working as designed, with one exception:
Range b4:b100 are lookup formulas from another sheet where everything below B34 is a #value! error where I'm specifying =iferror(formula),""
It is copying the resulting "" and so the next time I it runs, it begins to paste on the target sheet on B101 rather than B35.
How can I specify "Do not use any space on the target sheet with blanks where formulas existed on the source sheet"?
Sub COPYTOSAVEDWORK()
Sheets("FORMULAWORKED").Range("B4:Q100").Select
Selection.Copy
Sheets("WORKED_CLAIMS").Cells(Rows.Count, "A").End(xlUp).Offset(1). _
PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=False
Exit Sub
End Sub
You can call .Value = .Value on the pasted range, and that will eliminate cells with the empty string:
Sub Test()
Dim formulaRng As Range
Set formulaRng = ThisWorkbook.Sheets("FORMULAWORKED").Range("B4:Q100")
With ThisWorkbook.Sheets("WORKED_CLAIMS")
Dim nextRow As Long
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
formulaRng.Copy
.Cells(nextRow, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
With .Cells(nextRow, "A").Resize(formulaRng.Rows.Count, formulaRng.Columns.Count)
.Value = .Value
End With
End With
End Sub
A value transfer as per #BigBen would work great, but you seem to want to copy/paste numbers and NumberFormat. Maybe something like the below would work:
Sub Test()
Dim rng As Range
Dim arr As Variant
With Sheets("FORMULAWORKED")
.Range(Join(Filter(.[TRANSPOSE(IF(B4:B100<>"","B"&ROW(B4:B100)&":Q"&ROW(B4:B100),"|"))], "|", False), ",")).Copy
Sheets("WORKED_CLAIMS").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End Sub
I want to copy data in certain cells to another sheet in a table.
My code copies the data and searches for the cell to be pasted to. If there is a value in the destination cell, it is looped to check the subsequent rows in the same column until it finds an empty cell.
If there's 2000 rows of data currently in the table, it will search all 2000 cells before landing in the 2001st row.
The amount of time taken to execute the code is affected by the size of the table.
Is there any way to execute faster?
Below is a sample, its copying data from two cells.
Sub Test()
Sheets("Sheet1").Select
Range("K10").Select
Selection.Copy
Sheets("Table").Select
Range("A2").Select
Do While Not (ActiveCell.Value = "")
ActiveCell.Offset(1, 0).Activate
Loop
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet1").Select
Range("G15").Select
Selection.Copy
Sheets("Table").Select
Range("B2").Select
Do While Not (ActiveCell.Value = "")
ActiveCell.Offset(1, 0).Activate
Loop
End sub
Try following sub.
Sub CopyPaste()
Dim sht1, sht2 As Worksheet
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Table")
sht1.Range("K10").Copy sht2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
sht1.Range("G15").Copy sht2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
End Sub
It's unclear on whether you expect to find interim blank cells within the worksheet's used range or whether you expect to always put the new values at the bottom of the used range. This should work for both scenarios.
Sub Test()
Dim ws1 As Worksheet
Set ws1 = Worksheets("sheet1")
With Worksheets("table")
'force a definition for a .UsedRange on the worksheet
.Cells(.Rows.Count, "A") = Chr(32)
.Columns(1).SpecialCells(xlCellTypeBlanks).Cells(1) = ws1.Cells(10, "K").Value
.Columns(1).SpecialCells(xlCellTypeBlanks).Cells(1) = ws1.Cells(15, "G").Value
'clear the artificial .UsedRange
.Cells(.Rows.Count, "A").Clear
'Debug.Print .UsedRange.Address(0, 0)
End With
End Sub
I am trying to copy the formula from a cell in column C straight across to column F. I always want to copy the formula from column C and drag through column F, however the row should be determined by the active cell. Once the formula is dragged across I want to drag those formulas down to the last row with data in column B.
So far my VBA from my recorded macro looks like this:
ActiveCell.FormulaR1C1 = _
"=INDEX('Item Setup'!C2:C40,MATCH(R[-8]C2,'Item Setup'!C2,0),MATCH(R4C,'Item Setup'!R4C2:R4C40,0))"
Range("C13").Select
Selection.AutoFill Destination:=Range("C13:F13"), Type:=xlFillDefault
Dim lastRow As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
Range("C13:F13").AutoFill Destination:=Range("C13:F" & lastRow)
Range("C13:F13").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Think you can do this in one go, and also without having to use Select or Autofill.
Not generally advisable though to base a macro on the active cell.
Sub x()
Dim lastRow As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
With Range(Cells(ActiveCell.Row, "C"), Cells(lastRow, "F"))
.FormulaR1C1 = _
"=INDEX('Item Setup'!C2:C40,MATCH(R[-8]C2,'Item Setup'!C2,0),MATCH(R4C,'Item Setup'!R4C2:R4C40,0))"
.Value = .Value
End With
End Sub
First, stay away from ActiveCell, Selection and Select, instead use fully qualified Range and Worksheet objects.
Second, you can set your entire range where you want to add your formula, and then fill it at once, without dragging or anything like it.
Modified Code
Dim Sht As Worksheet
Dim AnchorRng As Range
Dim LastRow As Long
Set Sht = ThisWorkbook.Sheets("YourSheetName") ' modify with your sheet's name
With Sht
Set AnchorRng = ActiveCell ' .Range("C13") ' start point of your formula
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row ' get last row in column B
.Range(AnchorRng, .Cells(LastRow, "F")).FormulaR1C1 = _
"=INDEX('Item Setup'!C2:C40,MATCH(R[-8]C2,'Item Setup'!C2,0),MATCH(R4C,'Item Setup'!R4C2:R4C40,0))"
End With
Note: this code is not debugging your formula, just assigning to your entire range.