I am trying to copy data from sheet to another sheet based on a filter.
Based on Column Q where autofilter criteria is "P", I need to copy column T & U from sheet ORD_CS to sheet Namechk.
Here is my code. No error but the entire column is getting copied.
Sub Macro26()
'
'Match Personal Names
'
'
Dim i As Long, LR As Long
Dim sht, sht1 As Worksheet
Set sht = ActiveWorkbook.Worksheets("ORD_CS")
Set sht1 = ActiveWorkbook.Worksheets("Namechk")
sht.Range("A7:AC7").AutoFilter Field:=17, Criteria1:="P"
sht.Range("T7:U99999").Copy
sht1.Range("A1").PasteSpecial
Application.CutCopyMode = False
End Sub
Try this:
sht.Range("T7:U99999").SpecialCells(xlCellTypeVisible).Copy sht1.Range("A1")
instead of
sht.Range("T7:U99999").Copy
sht1.Range("A1").PasteSpecial
Sub filter_paste()
Dim sht, sht1 As Worksheet
Set sht = ActiveWorkbook.Worksheets("ORD_CS")
Set sht1 = ActiveWorkbook.Worksheets("Namechk")
sht.Range("A:AC").AutoFilter Field:=17, Criteria1:="P"
sht.Range("T7:U99999").Copy sht1.Range("A1")
End Sub
Related
screenshot of code
I am trying to calculate sum in cell "I13" of sheet2 with inputs based on the dynamic range.
Formula
range("I13").formula= "=sum('sheet1'!A1:A3)"
works but the range can be dynamic. For this I have used lr to identify the last row in the range
lr=cells(rows.count,1).end(xlup).row
Now, I want to modify the above formula such that in place of A3, it takes last cell. i.e. A&lr
Have tried using range("I13").formula= "=sum('sheet1'!A1:A"&lr)", but it results in error
Sub MMM()
Windows("Template.xlsx").activate
sheets("sheet1").select
range("a1").select
lr=cells(rows.count,1).end(xlup).row
sheets("sheet2").select
'this code works. But want dynamic range
'range("I13").formula = "= SUM('sheet1'!A1:A3)"
range("I13").formula = "= sum('sheet1'!A1:A&lr)"
End Sub
you can try to define the variable:
Option Explicit ' It should be used when you define variable
Sub MMM()
Dim lr as Range ' Define variable
Windows("Template.xlsx").activate
sheets("sheet1").select
range("a1").select
lr=cells(rows.count,1).end(xlup).row
sheets("sheet2").select
range("I13").formula = "= sum('sheet1'!A1:A&lr)"
End Sub
You have to join the string for the formula like this:
"=SUM('Sheet1'!A1:A" & lastRow & ")"
Alternatively:
If you set the whole range to be summed then you can use the Address of this range. The External-parameter returns the sheet name as well.
Sub MMM()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsSource As Worksheet: Set wsSource = wb.Worksheets("Sheet1")
Dim wsTarget As Worksheet: Set wsTarget = wb.Worksheets("Sheet2")
Dim rgDataToSum As Range
With wsSource
Set rgDataToSum = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
End With
wsTarget.Range("I13").Formula = "=SUM(" & rgDataToSum.Address(True, True, External:=True) & ")"
End Sub
I need to write a code in order to perform the below action:
From a column, select only the colored cells (eg. in yellow) and copy them under another column already filled with values at the bottom of the list
Here the code i wrote so far however i have troubles writing the part to copy the colored cells to the other sheet:
copycolor Sub m()
Dim wk As Workbook
Dim sh As Worksheet
Dim rng As Range
Dim C As Range
Set wk = ThisWorkbook
With wk
Set sh = .Worksheets("Base Dati Old")
End With
With sh
Set rng = .Range("A:A")
For Each C In rng
If C.Interior.ColorIndex = 46 Then
C.Copy
End If
Next C
End With
End Sub
Assuming you have headers in your data I'd advise to do two things:
Don't loop all cells in column A, it will slow down things significanlty.
If headers are present, applying a filter based on color might be a more optimal way.
For example:
Sub CopyColor()
Dim wk As Workbook: Set wk = ThisWorkbook
Dim sht As Worksheet: Set sht = wk.Worksheets("Base Dati Old")
Dim lr As Long, rng As Range
'Define last used row;
lr = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
'Set range;
Set rng = sht.Range("A1:A" & lr)
'Filter your data on yellow;
rng.AutoFilter 1, RGB(255, 255, 0), xlFilterCellColor
'Copy filtered cells;
rng.SpecialCells(12).Offset.Copy wk.Worksheets("DestinationSheet").Range("A1")
'Turn off filter
rng.AutoFilter
End Sub
Don't forget to change the name of the sheet you'd want to copy your data to. You may also need to find the last used row for that sheet and make that part dynamic.
Good luck.
I would like to write a macro to copy only a range of Cells that has data and ignore cells with a value of NA
I have built a helper tool to ensure data gathered from multiple sources are placed in the correct corresponding columns, then from there I copy and paste those columns into a master worksheet. The Range these values are populated in are A3 through R and In column R is a Vlookup.
I want to write a macro so I can press a macro enabled button to copy the cells in that range and end where the Vlookup stops returning a value. So far I have been able to write it so it copies to the end of the Vlookup but it is still gathering results that include the formula in R.
Currently Written:
Sub Copy()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
ws.Range(ws.[A:R], ws.Cells(Rows.Count, "R").End(xlUp)).Copy
End Sub
One way.
Use Autofilter.
Filter out the values which are not #N/A
Copy the filtered range in one go.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim rng As Range, filteredrng As Range
Dim lrow As Long
Set ws = Sheet1 '<~~ Change this to the relevant sheet
With ws
.AutoFilterMode = False
lrow = .Range("R" & .Rows.Count).End(xlUp).Row
Set rng = .Range("A3:R" & lrow)
With rng
.AutoFilter Field:=18, Criteria1:="<>#N/A"
Set filteredrng = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
End With
If Not filteredrng Is Nothing Then
'~~> COPY RANGE CODE HERE
End If
.AutoFilterMode = False
End With
End Sub
In the MasterSheet say I have column headers "Employee Names", "CarType" and "DOB". These columns and their row data are found in different sheets in the same workbook. I need a simple lookup function in VBA to search for multiple column headers and COPY over the entire column. I need multiple columns in the master file to be filled in like this so a loop function is needed.
If a heading is not found leave the row blank and move on to the column header on the MasterSheet.
Thank you in advance! My first post and so I don't know if the explanation above helps.
Sample MasterSheet
Sheet2 where one column head is
The below basic code is what I found but it's too basic and doesn't loop through
Macro VBA to Copy Column based on Header and Paste into another Sheet
This is what I have so far but the limitations are that it looks at one sheet at a time and the header search is not dynamic.
Sub MasterSheet()
Dim newSht As Worksheet, sSht As Worksheet, Hdrs As Variant, i As Long, EdrisRange As
Range
Set sSht = ActiveSheet
'Expand the array below to include all relevant column headers - I want the below
line to be dynamic. Looking at multiple headers from the MasterSheet.
Hdrs = Array("Heading 1")
Application.ScreenUpdating = False
Set newSht = Worksheets.Add(after:=sSht)
With sSht.UsedRange.Rows(1)
For i = LBound(Hdrs) To UBound(Hdrs)
Set EdrisRange = .Find(Hdrs(i), lookat:=xlWhole)
If Not EdrisRange Is Nothing Then
Intersect(EdrisRange.EntireColumn, sSht.UsedRange).Copy
Destination:=newSht.Cells(1, i + 1)
End If
Next i
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub
Something like this should work:
Sub MasterSheet()
Dim wb As Workbook
Dim newSht As Worksheet, Hdrs As Variant, i As Long, EdrisRange As Range
Hdrs = Array("Heading 1", "Heading 2")
Set wb = ActiveWorkbook
Set newSht = wb.Worksheets.Add(after:=ActiveSheet)
For i = LBound(Hdrs) To UBound(Hdrs)
Set EdrisRange = FindHeaderInWorkbook(wb, CStr(Hdrs(i)), newSht)
If Not EdrisRange Is Nothing Then
Application.Intersect(EdrisRange.EntireColumn, EdrisRange.Parent.UsedRange).Copy _
Destination:=newSht.Cells(1, i + 1)
End If
Next i
Application.CutCopyMode = False
End Sub
'find a header *HeaderText* in a workbook *wb*, excluding the sheet *excludeSheet*
Function FindHeaderInWorkbook(wb As Workbook, HeaderText As String, excludeSheet As Worksheet)
Dim sht As Worksheet, rng As Range
For Each sht In wb.Worksheets
If sht.Name <> excludeSheet.Name Then
Set rng = sht.Rows(1).Find(what:=HeaderText, lookat:=xlWhole)
If Not rng Is Nothing Then Exit For
End If
Next sht
Set FindHeaderInWorkbook = rng
End Function
I have a excel file where I have used the filter on a specific column. After that it returned me 3 visible rows. Now I want to extract a cell value from visible 3 rows on same column. How to write the vba code for that.
Note: I am using UFT, vb script for connecting excel application.
Environment.value("Path1")="C:Test\Data1\"
Environment.value("FileName")="ExcelTest.xlsx"
Set obj = CreateObject("Excel.Application")
obj.visible=True
Set obj1 = obj.Workbooks.Open(Environment("Path1")&Environment("FileName"))
Set obj2=obj1.Worksheets("RESULT")
obj2.Range("L1").Autofilter 12,"abcdef"
obj2.Range("A1").Autofilter 1,Array("Bucket",2,"Material","Flags"),7
rows=obj2.usedrange.columns(1).specialcells(12).count-1
if you want to work with visible cells only.
An example in which you filter on column A, to be adapted for you data, of course:
Sub test()
Dim ws As Worksheet
Dim i As Long, LastRow As Long
Dim r As Range, Cell As Range, Range As Range
Set ws = ThisWorkbook.Sheets("Sheet1")
Set r = ws.Range("A1")
ws.AutoFilterMode = False
With r
.AutoFilter Field:=1, Criteria1:="Yourcriteria"
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set Range = ws.Range(ws.Cells(2, 1), ws.Cells(LastRow, 1))
For Each Cell In Range.SpecialCells(xlCellTypeVisible)
'whatever you need to be done
Next Cell
End With
ws.AutoFilterMode = False
End Sub