I'm trying to create a vba that copy the cell that match my condition and paste it to another sheet but my problem is it copy all rows with that matched with what I am looking for. I only need to copy the cell that matched. Here is my code
Sub format()
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Sheet1").Cells(i, 1).Value Like "*application_id*" Then
Worksheets("Sheet1").Cell(i).Copy
Worksheets("Sheet2").Activate
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet2").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Sheet1").Activate
End If
Next
End Sub
For the beginning you should avoid all those activate stuff.
I gets a little confusing
I think your problem lies in: Worksheets("Sheet1").Rows(i).Copy
Sub format()
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Sheet1").Rows(i, lColumn).Value Like "*application_id*" Then
Temp = Sheets("Sheet1").Cells(i,lColumn).value
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet2").Cells(b + 1, 1) = Temp
End If
Next i
End Sub
Related
I want to copy paste values from 4 columns in one worksheet into 4 columns of another worksheet depending on whether the values in a single column are null or not.
Following is my code:
Private Sub CommandButton1_Click()
Dim lastrow As Long, erow As Long
lastrow = Worksheets("jun").Cells(Rows.Count, 1).End(xlUp).Row
erow = 20
For i = 8 To lastrow
If Worksheets("jun").Cells(i, 16).Value <> "" Then
Worksheets("jun").Cells(i, 16).Copy
Worksheets("jun").Paste Destination:=Worksheets("test").Cells(erow + 1, 1)
Worksheets("jun").Cells(i, 3).Copy
Worksheets("jun").Paste Destination:=Worksheets("test").Cells(erow + 1, 2)
Worksheets("jun").Cells(i, 2).Copy
Worksheets("jun").Paste Destination:=Worksheets("test").Cells(erow + 1, 3)
Worksheets("jun").Cells(i, 6).Copy
Worksheets("jun").Paste Destination:=Worksheets("test").Cells(erow + 1, 4)
erow = erow + 1
End If
Next i
End Sub
However this code produces an error when I try to paste the values into the second column of the test worksheet and I suspect this is because it is made of a merged column.
Following is the picture that shows the merged column. How could I combat this issue?
Having experimented slightly it appears .PasteSpecial Paste:=xlPasteValues will cause an error pasting into merged cells but .PasteSpecial Paste:=xlPasteValuesAndNumberFormats can paste into merged cells without that error
Try the updated sub below:
please note a slight alteration to the paste columns to take into account the merged column. I have also adjusted erow so it starts at 21 to avoid having to use 'erow + 1' for all entries
Private Sub CommandButton1_Click()
Dim lastrow As Long, erow As Long
With Worksheets("jun")
erow = 21
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 8 To lastrow
If .Cells(i, 16).Value <> "" Then
.Cells(i, 16).Copy
Worksheets("test").Cells(erow, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Cells(i, 3).Copy
Worksheets("test").Cells(erow, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Cells(i, 2).Copy
Worksheets("test").Cells(erow, 4).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Cells(i, 6).Copy
Worksheets("test").Cells(erow, 5).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
erow = erow + 1
End If
Next i
End With
End Sub
Is this the line causing the issue?
Worksheets("jun").Paste Destination:=Worksheets("test").Cells(erow + 1, 3)
It sounds like you're trying to paste in the third column but when you merge columns, the left most column becomes the primary. For example, you've merged B&C (cols 2 and 3) so any reference to 3 is now redundant. You'd either paste in to column 2 or 4. With that row, if you're trying to paste in to column D, you'd need to reference column 4, not 3.
I made this code to copy data from Sheet1 to Sheet2 if the color of the cell is green (after conditional formatting it turns green). But it is giving me error in the color condition. Any suggestions ?
Private Sub CommandButton1_Click()
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Sheet1").Interior.ColorIndex = 14 Then
Worksheets("Sheet1").Rows(i).Copy
Worksheets("Sheet2").Activate
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet2").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Sheet1").Activate
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select
End Sub
Few things to consider, the For Loop will iterate through column A of Sheet1 and copy the full row to Sheet2 in the next available row, if it meets the criteria:
Private Sub CommandButton1_Click()
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
If Worksheets("Sheet1").Cells(i, "A").Interior.ColorIndex = 14 Then
Worksheets("Sheet1").Rows(i).Copy
Worksheets("Sheet2").Range("A" & b).PasteSpecial xlPasteAll
Application.CutCopyMode = False
End If
Next i
End Sub
You set
Application.CutCopyMode = False
So there is nothing in the buffer to paste. Move that line to after the PasteSpecial
You'd be better off not copying and pasting. When you copy/paste you muck with the user's copy/paste buffer. It's generally better to assign values and other aspects directly:
myTargetRange.Value = mySourceRange.Value
myTargetRange.Formula = mySourceRange.Formula
myTargetRange.RowHeight = mySourceRange.RowHeight
etc.
I'm working on an Excel project where I am trying to produce certain rows from "Sheet 1" that contains a word called "external" in column C and then copy and paste that row into "Sheet 3"
I understand that there is a thing called "filter" but that is not an option.
This project is for my team at work that wants to be able to extract rows and columns that are shown as "external" and then be able to paste them and other information to another sheet that contains that information.
Private Sub CommandButton1_Click()
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Sheet1").Cells(i, 3).Value = "External" Then
Worksheets("Sheet1").Rows(i).Copy
Worksheets("Sheet3").Activate
b = Worksheets("Sheet3").Cells(Row.Count, 1).End(xlUp).Row
Worksheets("Sheet3").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Sheet1").Activate
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select
End Sub
The expected result was to display all rows that contained the word "External" in Sheet 1 Column C into a new sheet and have all its information displayed in Sheet 3.
Excel Worksheet for Reference:
First, declare all your variables. Next, you can try changing If Worksheets("Sheet1").Cells(i, 3).Value = "External" Then to If Worksheets("Sheet1").Range("C" & i).Text = "External" Then. See here:
Private Sub CommandButton1_Click()
Dim a As Long
Dim i As Long
Dim b As Long
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Sheet1").Range("C" & i).Text = "external" Then
Worksheets("Sheet1").Rows(i).Copy
Worksheets("Sheet3").Activate
b = Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet3").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Sheet1").Activate
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select
End Sub
I have an excel worksheet with example data in column A like
row 1 has a
row 2 has b
row 3 has c
row 4
row 5 has d
Using my macro i want to add a new row above where ever there is data in the selected cell. As row 1 cell has data "a" macro should add a row and goto next cell. row 4 has no data so it should skip this row check the next
i have macro below
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
FinalRow1 = FinalRow + FinalRow
ActiveSheet.Range("A1").Select
For i = 1 To FinalRow1
If Cells(i, 1).Value = vbNullString Then
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Else
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(rowOffset:=2, columnOffset:=0).Activate
'ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
End If
Next i
It seems to work some times and other times it simply does not add the expectd row.
Can someone please help
The FASTEST and DIRTY answer is:
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
FinalRow1 = FinalRow + FinalRow
ActiveSheet.Range("A1").Select
For i = 1 To FinalRow1
If Cells(i, 1).Value = vbNullString Then
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Else
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(rowOffset:=2, columnOffset:=0).Activate
I = I +1 ' BECAUSE you have increased the next row number by 2
End If
Next i
The real problem: you have a loop with 2 running data:
the loop varable I
AND the actual position of ActiveCell
When you insert a row, they will not show the same data anymore.
It would be much nicer
if you forget For loop and rely only ActiveCell.Offset position
OR if you forget ActiveCell.Offset and rely only the For loop I variable.
Either way is OK, but you mixed - and in my answer I left this mix, just focused that loop varable I and ActiveCell.Offset should be in offset.. ;-)
Made some changes in your code. But it is always better to loop from last row to first row.
Sub Demo()
Dim flag As Boolean
finalrow = Cells(Rows.count, 1).End(xlUp).Row + 1
FinalRow1 = finalrow + finalrow
ActiveSheet.Range("A1").Select
flag = False
For i = 1 To FinalRow1
If ActiveCell.Value = vbNullString Then
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
flag = True
Else
If flag = False Then
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(rowOffset:=2, columnOffset:=0).Activate
Else
flag = False
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
End If
End If
Next i
End Sub
One drawback of this code is that it loops for few extra number of times when not needed, will work on it in sometime.
I'm trying to create a vba code but I'm not succeeding.
I want to search on COLUMN "F", for value: "Answered"
then copy row from "COLUM B TO F" and paste on sheet "ControlAnswered" lastrow;
Try this,
Sub SpecialCopy()
Dim targetSh As Worksheet
Set targetSh = ThisWorkbook.Worksheets("ControlAnswered")
Dim i As Long
For i = 1 To Cells(Rows.Count, "F").End(xlUp).Row
If Cells(i, 6).Value = "Answered" Then
Range(Cells(i, 2), Cells(i, 6)).Copy Destination:=targetSh.Range("A" & targetSh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
End If
Next i
End Sub
I should say that you will not always going to find people that will write code for you