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.
Related
I have a small VBA code to copy a row from one sheet and paste to another, it works fine for paste but not for paste special, as I am trying to paste values only and not just paste.
this is my code, very basic. Noted that the pastespecial is changed to paste the code works fine.
thanks for you help
Private Sub CommandButton1_Click()
a = Worksheets("Inventory List Costing Review").Cells(Rows.Count, 1).End(xlUp).Row
For i = 10 To a
If Worksheets("Inventory List Costing Review").Cells(i, 19).Value = "Completed" Then
Worksheets("Inventory List Costing Review").Rows(i).Copy
Worksheets("Completed by Sales").Activate
b = Worksheets("Completed by Sales").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Completed by Sales").Cells(b + 1, 1).Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, operation:=xlNone
Worksheets("Inventory List Costing Review").Activate
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Inventory List Costing Review").Cells(1, 1).Select
End Sub
PasteSpecial xlPasteValues vs Assigning Values
A Quick Fix
If you insist on using PasteSpecial, in the IF clause you can use:
Worksheets("Inventory List Costing Review").Rows(i).Copy
b = Worksheets("Completed by Sales").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Completed by Sales").Cells(b + 1, 1).PasteSpecial Paste:=xlPasteValues
But a better (more efficient) way is:
b = Worksheets("Completed by Sales").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Completed by Sales").Rows(b + 1).Value = _
Worksheets("Inventory List Costing Review").Rows(i).Value
when Application.CutCopyMode = False and ... Cells(1, 1).Select are not needed anymore.
Improvements
If you use Option Explicit, it will 'force' you to qualify all variables (a, b).
If you additionally qualify the workbook and worksheets, the code becomes quite readable.
Since the code can be run from a command button on any sheet, you can give it a suitable name and put it into a standard module. Then you can easily call it in the click event code of a command button (located in a sheet module).
Standard Module e.g. Module1
Option Explicit
Sub updateSales()
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
Dim src As Worksheet
Set src = wb.Worksheets("Inventory List Costing Review")
Dim tgt As Worksheet
Set tgt = wb.Worksheets("Completed by Sales")
Dim a As Long
Dim b As Long
a = src.Cells(src.Rows.Count, 1).End(xlUp).Row
For i = 10 To a
If src.Cells(i, 19).Value = "Completed" Then
b = tgt.Cells(tgt.Rows.Count, 1).End(xlUp).Row
tgt.Rows(b + 1).Value = src.Rows(i).Value
End If
Next
End Sub
Sheet Module e.g. Inventory List Costing Review and/or Completed by Sales
Option Explicit
Private Sub CommandButton1_Click()
updateSales
End Sub
The following should work (cleaned up a bit of clutter along the way).
Although if you're just copying data from cells it would be faster to assign the values directly to the destination cells instead of copy-pasting.
Private Sub CommandButton1_Click()
With Worksheets("Inventory List Costing Review")
a = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 10 To a
If .Cells(i, 19).Value = "Completed" Then
.Rows(i).Copy
b = Worksheets("Completed by Sales").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Completed by Sales").Cells(b + 1, 1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone
End If
Next
Application.CutCopyMode = False
.Cells(1, 1).Select
End With
End Sub
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 am copy - pasting values from one worksheet to another. The problem is that I have two merged cells where I want to input my data, these are D:E. Same data from B67 goes to two merged cells which are located in Offset(-1, -1) and Offset(-24, 0)
My code:
Private Sub CommandButton2_Click()
'Paste to a Defined Range
ThisWorkbook.Sheets("Other Data").Range("L67").Copy
'Offset Paste (offsets 2 cells down and 1 to the right
ActiveCell.PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Other Data").Range("B67").Copy
ActiveCell.Offset(-1, -1).PasteSpecial xlPasteValues
ActiveCell.Offset(-24, 0).PasteSpecial xlPasteValues
End Sub
I receive an error on:
ActiveCell.Offset(-1, -1).PasteSpecial xlPasteValues
This cell is located 1 cell up and 1 to the left. If I unmerge this cell the code works fine. However it should be merged to fit my text.
The same with:
ActiveCell.Offset(-24, 0).PasteSpecial xlPasteValues
Hi I think it is connected to the xlpastevalues. Try using xlPasteAll and see if that fixes your issue.
This will work.
Private Sub CommandButton2_Click()
Dim Temp As Variant
Dim R As Long
Temp = ThisWorkbook.Sheets("Other Data").Range("L67").Value
With ActiveCell
R = .Row
If R > 1 And .Column > 1 Then .Offset(-1, -1).MergeArea.Value = Temp
If R > 24 Then .Offset(-24, 0).MergeArea.Value = Temp
End With
End Sub
Since we are copying only values, wouldn't it be easier to just do this?
ActiveCell.Offset(-1, -1) = Range("B67")
Or if the formula is different from the value:
ActiveCell.Offset(-1, -1).Value = Range("B67").Value
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
I have a nightmare task to migrate from one accounting package to another.
I have 9340 rows in columns A,B and G which needs to be ordered in a certain way before it can be imported by new system.
Before:
After:
I ran a macro that does what I want but only for selected range. How do I make macro work for entire sheet?
Sub Macro1()
Range("B206").Select
Selection.Cut
Range("A207").Select
ActiveSheet.Paste
Rows("206:206").Select
Selection.Delete Shift:=xlUp
Range("A206").Select
Selection.Copy
Range("A206:A216").Select
ActiveSheet.Paste
Range("C216").Select
Application.CutCopyMode = False
Selection.Cut
Range("G216").Select
ActiveSheet.Paste
End Sub
This will likely fail in some respect. Your setup is more complicated than I have time to re-create. Please run this code on a copy of your data. It basically moves things around and then deletes all the rows that have blanks in column B. You should delete the header junk above the first "Opening" row:
Sub test()
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim cell As Excel.Range
Set ws = ActiveSheet
With ws
LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
For Each cell In .Range("B1:B" & LastRow)
If Left(cell.Value, Len("Opening")) = "Opening" Then
cell.Offset(1, -1).Value = cell.Value
cell.ClearContents
Else
cell.Offset(0, -1) = cell.Offset(-1, -1).Value
End If
If Left(cell.Value, Len("Closing")) = "Closing" Then
cell.Offset(0, 6).Value = cell.Offset(0, 1).Value
cell.Offset(0, 1).ClearContents
End If
Next cell
.Range("B" & .Rows.Count).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub