I want to write one vba code which will search data from a specific column of sheet1 and copy those rows and paste those to sheet2. I have written the code but found one problem there. here is the code below.
Sheets("Sheet1").Select
Range("D1").Select
Dim mycode As Worksheet
Set mycode = ThisWorkbook.Worksheets("Sheet2")
Dim i As Long
For i = 2 To Cells(Rows.Count, "D").End(xlUp).Row
If Cells(i, 4).Value = "high" Then
Range(Cells(i, 1), Cells(i, 8)).Copy Destination:=mycode.Range("A" & mycode.Cells(Rows.Count, "A").End(xlUp).Row + 1)
ElseIf Cells(i, 4).Value <> "high" Then
Sheets("Sheet2").Select
Range("A2").Value = "No Crtical Logs Found"
End If
Next i
End Sub
From sheet1 column D(number4) I am searching data matching "high" and copy paste those rows to sheet2. And if any of the "high" is not there in column D then "No action required" will be written in cell A2 on sheet2. But the problem is when "high" value is not there it is working fine but when "high" value is there in D column sheet1 then all time "no action required" value is coming on cell A2 on sheet2. Please help me to rectify this.
No Crtical Logs Found 4/11/2016 Critical high 192.168.1.1 This is the sample excel sheet Action Required
Regards,
Pinaki
You are moving off Sheet1 too soon:
Sub fhskdfh()
Sheets("Sheet1").Select
Range("D1").Select
Dim mycode As Worksheet
Set mycode = ThisWorkbook.Worksheets("Sheet2")
Dim i As Long
For i = 2 To Cells(Rows.Count, "D").End(xlUp).Row
MsgBox i & vbCrLf & Cells(i, 4).Value
If Cells(i, 4).Value = "high" Then
Range(Cells(i, 1), Cells(i, 8)).Copy Destination:=mycode.Range("A" & mycode.Cells(Rows.Count, "A").End(xlUp).Row + 1)
End If
Next i
End Sub
Change your destination of the "No Crtical Logs Found" message
From
Sheets("Sheet2").Select Range("A2").Value
To
Sheets("Sheet2").Range("A2").Value
You do not need to select the cell before assigning a value to it.
Related
I have a macro that is supposed to identify cells containing data in a column, and then copy multiple columns from said cells row into another worksheet.
19 rows that fit the Criteria to be copied (and don't contain any words that come up in my 5 exceptions) aren't being copied.
I tried to go through the macro step by step, working with stopping points and changing around the macro itself.
My theory is there is something wrong with the Cells in the sheet it is supposed to copy from.
Sub Copy_Range()
Dim zelle, cell As Range
Dim i As Long
On Error Resume Next
Worksheets("Worksheet 4").Activate
Application.GoTo Worksheets("Worksheet 4").Range("C2:H1000")
Application.ScreenUpdating = False
Worksheets("Worksheet 4").Activate
Range("C2:C1000,D2:D1000,E2:E1000,F2:F1000,G2:G1000,H2:H1000").Clear
Worksheets("Worksheet 1").Activate
Range("A6").Activate
'This part Shows an alert when theres no Data entered in column A
If WorksheetFunction.CountA(Range("A6:A1000")) = 0 Then
Dim click As Integer
click = MsgBox(prompt:="There was no data Entered in Column A", Buttons:=vbExclamation)
Cells(1, 1).Select
Exit Sub
End If
Set Tbl2 = ThisWorkbook.Worksheets("Worksheet 1").ListObjects("Tabelle33")
LastRow4 = Tbl2.ListColumns(1).Range.Rows.Count
Set cell = Cells(ActiveCell.Row, ActiveCell.column)
'This part is supposed to look through Column A in Worksheet 1
'If there is data entered in column A of a row the Macro copies the data entered in column 1, 2, 3, 5, 6 and 7 of that row into Worksheet 4,
'UNLESS the Data entered in Column A is one of 5 exceptions.
For Each zelle In Worksheets("Worksheet 1").Range(Cells(Rows.Count, cell.column), Cells(cell.Row, cell.column))
If ActiveCell.Value = "" Then
Selection.End(xlDown).Select
**ElseIf ActiveCell.Value = "Exception 1" Then**
**Selection.End(xlDown).Select**
**ElseIf ActiveCell.Value = "Exception 2" Then**
**Selection.End(xlDown).Select**
**ElseIf ActiveCell.Value = "Exception 3" Then**
**Selection.End(xlDown).Select**
**ElseIf ActiveCell.Value = "Exception 4" Then**
**Selection.End(xlDown).Select**
**ElseIf ActiveCell.Value = "Exception 5" Then**
**Selection.End(xlDown).Select**
Else
Union(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 3), Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 6), Cells(ActiveCell.Row, 7)).Copy
Application.GoTo Worksheets("Worksheet 4").Cells(2, 3)
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Selection.PasteSpecial Paste:=xlPasteAll
Range("C2:H2").Select
Selection.Insert Shift:=xlDown
Worksheets("Worksheet 1").Activate
ActiveCell.Offset(1, 0).Select
End If
Next
Worksheets("Worksheet 4").Activate
Range("C2:H1000").Interior.Color = xlNone
End Sub
Edit: the problem seems to be the ** Starred ** lines in my code aka. my "Exceptions"
I have since removed that snippet and am working on a new bit of code that filters through column A and then deletes the Exceptions after the fact, instead of not copying them from the start.
You are missing Dim zelle AS RANGE
While defining variables on the same line each varaible must be defined separately so
Dim zelle as range, cell as range
Also try
replacing If ActiveCell.Value by If zelle.value
Try this code:
Dim LR as long
Dim cell as range
LR = Thisworkbook.worksheets("name of your worksheet").range("A" & rows.count).end(xlup).row
for cell in range("A1","A"& LR)
if cell.value =
'add here all your exceptions scenarios
else
'copy the data code
end if
next cell
I'm new with VBA and I am trying to create a macro for work to make everyone's life easier. My goal is to copy rows (or just copy the data in the first column when the second column is "0") from one worksheet named "Bulk Update" with the condition of column B having the value "0" to the last worksheet, at the bottom of the worksheet after the data. I don't know how to reference the last worksheet name. Here is the code that I made (please don't judge me as I am still new and googling around), which I know is completely wrong...
Public Sub CNPPrevOOS()
Worksheets("Bulk Update").Select
a = Worksheets("Bulk Update").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Bulk Update").Cells(i, 2).Value = "0" Then
Selection.Copy
ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count).Range("A1").Value = 100
Range("A30000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
You could try the below code.
The data is being filtered for Column 2 = 0. Only those rows are copied and pasted in the last worksheet
Public Sub CNPPrevOOS()
Worksheets("Bulk Update").Select
a = Worksheets("Bulk Update").Cells(Rows.Count, 1).End(xlUp).Row
'Filters the data where column 2 = 0
ActiveSheet.Range(Cells(1, 1), Cells(a, 2)).AutoFilter Field:=2, Criteria1:="0", Operator:=xlFilterValues
'Select only the filtered cells and copy
Range(Cells(2, 1), Cells(a, 1)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count).Select
ActiveSheet.Paste Destination:=Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
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 trying to copy certain column from one worksheet to another but when I apply my code, I get no errors but also no results. I get blank paper. I applied this methodolgy on copying a certain row and it was copied to another worksheet perfectly.
This is regarding the successful attempt to copy row.
The code works just fine:
Sub skdks()
Dim OSheet As Variant
Dim NSheet As Variant
Dim i As Integer
Dim LRow As Integer
Dim NSLRow As Integer
OSheet = "Tabelle3" 'Old Sheet Name
NSheet = "Tabelle5" 'New Sheet Name
LRow = Sheets(OSheet).Cells(Rows.Count, 1).End(xlUp).row 'Last Row in Old Sheet
Sheets(OSheet).Activate
For i = 2 To LRow
'Finds last row in the New Sheet
If Sheets(NSheet).Cells(2, 1) = "" Then
NSLRow = 1
Else
NSLRow = Sheets(NSheet).Cells(Rows.Count, 1).End(xlUp).row
End If
'If cell has "certain # then..."
If Cells(i, 1).Value = Cells(13, 2).Value Then
Cells(i, 1).EntireRow.Copy
Sheets(NSheet).Cells(NSLRow + 1, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next i
End Sub
This little piece of code is the failed attempt to copy column to another worksheet.
Sub trial()
Dim OSheet As Variant
Dim NSheet As Variant
Dim j As Integer
Dim LColumn As Integer
Dim NSLColumn As Integer
OSheet = "Tabelle2" 'Old Sheet Name
NSheet = "Tabelle5" 'New Sheet Name
LColumn = Sheets(OSheet).Cells(1, Columns.Count).End(xlToLeft).Column 'Last Column in Old Sheet
Sheets(OSheet).Activate
For j = 2 To LColumn
'Finds last column in the New Sheet
If Sheets(NSheet).Cells(1, 2) = "" Then
NSLColumn = 1
Else
NSLColumn = Sheets(NSheet).Cells(1, Columns.Count).End(xlToLeft).Column
End If
'If cell has "certain # then..."
If Cells(2, j) = Cells(13, 2) Then
Cells(2, j).EntireColumn.Copy
Sheets(NSheet).Cells(2, 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next j
End Sub
....
'If cell has "certain # then..."
If Cells(2, j) = Cells(13, 2) Then
debug.Print Cells(2, j).Address; " = "; Cells(13, 2).Address; " ---- COPY"
debug.print Cells(2, j).EntireColumn.address; Cells(2, j).EntireColumn.cells.count
debug.Print Sheets(NSheet).Cells(2, 2).Address
Cells(2, j).EntireColumn.Copy
Sheets(NSheet).Cells(2, 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
....
With the line If Cells(2, j) = Cells(13, 2) Then you compare the different cells from row 2 (B2, C2, D2, ...) with the value of cell "B13". If the value is the same you copy this column to the new worksheet.
Is there any equal value in your data? If yes you should get an error message with your code.
You try to copy the values of an entire column to the range starting with "B2". Of cause there is not enough space for this.
=> Either you reduce the source range or you start the destination range on row 1!
To add to the paste destination size, if you really want to paste the entire column, you either need to start at the beginning of the column or choose the entire column. Also, I think you want to make the paste column increase with your NSLColumn
If Cells(2, j) = Cells(13, 2) Then
Cells(2, j).EntireColumn.Copy
Sheets(NSheet).Columns(NSLColumn + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
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