I am writing a code to perform a formula on column "K", change its format and then copy and paste it in column "A".
I am also trying to copy and paste column "I" to column "B". "i" determines the numebr of cells in column B.
here is my code so far:
Sub Test()
Dim i As Long
i = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
With Range("K3:K" & i)
.Formula = "=DATE(A3,G3,H3)"
.NumberFormat = "ddmmmyyyy"
.Copy
Range("A3:A" & i).PasteSpecial xlPasteFormats
End With
With Range("I3:I" & i)
.Copy
Range("B3:B" & i).PasteSpecial xlPasteFormats
End With
End Sub
Any ideas where I went wrong? I am new to VBA so this is most likely a minor mistake I am overlooking.
Edit: The adjusted formula is copying Column I to Column B properly, but Column K to Column A is wrong.
Lets say column K has the dates:
29Apr1921
08May1922
21Oct1923
Column A now has:
04Apr1905
05Apr1905
06Apr1905
The issue is that it was missing paste values and was only pasting the format. It also needed its own With statement after the Date formula was performed.
Sub Test()
Dim i As Long
i = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
With Range("K3:K" & i)
.Formula = "=DATE(A3,G3,H3)"
.NumberFormat = "ddmmmyyyy"
End With
With Range("K3:K" & i)
.Copy
Range("A3:A" & i).PasteSpecial xlPasteValues
Range("A3:A" & i).PasteSpecial xlPasteFormats
End With
With Range("I3:I" & i)
.Copy
Range("B3:B" & i).PasteSpecial
End With
End Sub
Related
I have two worksheets, named "Monthly" and "Index", in a workbook.
In Index, cell A1 will have a value after some calculations.
I need to copy that value into "Monthly" Column "J".
It shall be one by one using next row coding.
Private Sub CommandButton2_Click()
Dim i As Integer
a = Worksheets("Monthly").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
Range("K" & i).Copy Worksheets("Rule of 78").Range("D6")
'Range("A1").Offset(i - 1, 0).Copy Range("C1")
Range("I" & i).Copy Worksheets("Rule of 78").Range("D7")
Range("E" & i).Copy Worksheets("Rule of 78").Range("D8")
Range("A" & i).Copy Worksheets("Rule of 78").Range("D10")
Worksheets("Index").Range("C2").Copy " How to paste in Monthly sheet
column J, for every row, C2 is different"
Next i
End Sub
Does "A1" have a formula? If so Excel is probably copying a formula, thus the error.
Try:
Worksheets("Index").Range("A1").Copy
Worksheets("Monthly").Range("J" & i).PasteSpecial xlPasteValues
Edit: "A1" or "C2", I didn't get wich is giving you the error.
I'm looking to filter and move data from a main excel spreadsheet (sheet 1) into a new sheet (sheet 2) but all the advice I've found so far relates to filtering just one column of data and I want to move two. I also need to filter by a wildcard.
I've attached an image of my sheet 1, and what I'd ideally want to create in sheet 2.
Column A is date; column B is animal type; column C is weight.
I need to filter by a wildcard to find all the 'horses' in column B and then move the date, the animal type and the weight to spreadsheet 2.
I've managed to do the first part using
=IF(COUNTIF(Sheet1!B2,"*horse*"),Sheet1!B2,"")
but I'm stuck on the 2nd part of removing all the blank rows.
Animal weights
try this
Option Explicit
Sub horses()
With Worksheets("Sheet1").Range("B2:D100") '<== range containing data, headers included
.Sort key1:=.Columns(1), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
.AutoFilter field:=2, Criteria1:="*Horse"
If WorksheetFunction.Subtotal(103, .Cells) > .Columns.Count Then
.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Sheet2").Range("A1") '<== copying form cell "A1" of "Sheet2"
End If
End With
End Sub
adapt commented lines as per you needs
Use the below function to get your result. You can parse any content to this function to get the result in Sheet2.
Private Function filtercontent(content As String) As String
Lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Lastrow
If InStr(Cells(i, 2), content) > 0 Then
Worksheets("Sheet1").Range("A" & i, "C" & i).Copy
With Worksheets("Sheet2")
.Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
End With
End If
Next i
End Function
or
Private Function filtercontent(content As String) As String
Dim Lastrow As Long
Dim i As Integer
Lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Lastrow
If InStr(Cells(i, 2), content) > 0 Then
Worksheets("Sheet1").Range("A" & i, "C" & i).Copy Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1)
End If
Next i
End Function
for example if you want the apply the filter for Horse then
Sub testing()
filtercontent ("Horse")
End Sub
I have no experience with VBA and it's proving to be more difficult than what I imagined...in part because I don't know the syntax, but I have the following:
Sub testMe()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Worksheets("Sheet2").Range("A1").Copy Destination:=Range("A" & LastRow)
End Sub
This kinda works, but it's jamming everything into one cell in the first column. How do I merge the cells of the last row before pasting into it? The macro is supposed to find the last row of the last page, merge the cells of that row, and paste text that was copied from another cell. Thank you in advance.
This should do what you're after. You should just change the column number to reflect the column which you wish to merge cells until.
Option Explicit
Sub copy_and_paste_merge()
Dim last_row As Long
last_row = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(1, 1).Copy
Cells(last_row, 1).PasteSpecial Paste:=xlPasteValues
Range(Cells(last_row, 1), Cells(last_row, 5)).MergeCells = True 'change the column
End Sub
I ended up doing it like this...
Sub testMe()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A" & LastRow & ":L" & LastRow).Merge
Range("A" & LastRow) = Worksheets("Sheet2").Range("A1")
End Sub
I am Comparing cells in column D and if they match paste the value of the previous cell in column B into the next cell in column B if they do not match paste the value of the subseqent cell in column A into the cell in column B
e.g
IF(D2=D3,B2,A2+1)" but this is not working after running on the 1st sequence of cells in D I get #Valve!" for the rest of column B
I am sure this is the problem IF(D2=D3,B2,A2+1)" in-particular the A2+1 reference but not sure how to call it
(Sorry if this was unclear)
Thanks
Sub TargetId()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Sheets("UnPivot")
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").FormulaR1C1 = "Source"
Range("B2").FormulaR1C1 = [A2].Value
With ws
lRow = ws.Range("D" & .Rows.Count).End(xlUp).Row
With .Range("B3:B" & lRow)
.Formula = "=IF(D2=D3,B2,A2+1)"
.Value = .Value
End With
End With
End Sub
As follow up from comments, this one works:
With .Range("B3:B" & lRow)
.Formula = "=IF(D2=D3,B2,A3)"
.Value = .Value
End With
My code works almost as desired. It checks all sheets for a certain value in Column "F" and then copies its associated row to the active sheet. I can make the code copy the entire row, singular columns "A", or sequential ranges "A:C". I cannot seem to make it copy specific columns like "A" "C" & "F" which is what I need it to do.
Public Sub List()
Dim ws As Worksheet
Dim i As Integer
ActiveSheet.Rows("3:" & ActiveSheet.Rows.Count).Clear
Selection.Clear
For Each ws In Worksheets
If ws.Name <> ActiveSheet.Name Then
For i = 1 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If ws.Cells(i, "F").Value = "Pending" Then
ws.Cells(i, "A").Columns("A:D").Copy Destination:=ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next
End If
Next
As following from comments to Question, correct answer is to use following line:
ws.Range("A" & i & ", C" & i & ", E" & i).Copy Destination:=ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
instead
ws.Cells(i, "A").Columns("A:D").Copy Destination:=ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)