I am trying to copy certain cells if the word "FLAG" is a cell in that same row.
For example, I have data in excel like the following:
So if the word Flag is in any of the cells I want to copy the Description, Identifier and Final Maturity columns (Columns A-C) as well as the corresponding date column. So for the first row (AA) under Jan/Feb there is the word Flag. I would want to copy over columns A-E to another worksheet or table.
I would like to use a VBA but I am not sure how
The following code will do what you expect, each time it finds the word FLAG, the first 3 cells will be copied as well as the value for the given month will be copied to a new row, and if a second flag is found that will be copied to the next available row:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
Dim wsResult As Worksheet: Set wsResult = Sheets("Sheet2")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
For i = 2 To LastRow 'loop through rows
For x = 15 To 23 'loop through columns
If ws.Cells(i, x) = "FLAG" Then 'if FLAG found in column
NextFreeRow = wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row + 1 'get the next empty row of your wsResult sheet
ws.Range("A" & i & ":C" & i).Copy 'copy first three cells in given row
wsResult.Range("A" & NextFreeRow).PasteSpecial xlPasteAll 'paste into your Result sheet
ws.Cells(i, x - 11).Copy 'copy the value for which there was a flag
wsResult.Cells(NextFreeRow, 4).PasteSpecial xlPasteAll 'paste in the fourth cell in the sheet wsResult
End If
Next x
Next i
End Sub
Related
Sub Start()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("1")
Set ws2 = Sheets("2")
Dim LastRow As Long, i As Long
LastRow = Cells(Rows.Count, "D").End(xlUp).row
For i = 1 To LastRow
ws1.Range("D" & i).copy
ws2.Range("A2").PasteSpecial Paste:=xlPasteFormats
Next i
If ws1.Range("A" & i) = vbNullString Then
Exit Sub
End If
End Sub
I'm trying to make it so this code pastes the interior fill from column D, Into Column A, unless there is already interior fill present.
Any input appreciated.
Edit: I'm trying to copy the format (interior fill) from Sheet 1 and Sheet 2's Column A's (until the last row) and paste it to Sheet Column A. I'm trying to copy over once cell at a time, and ignore if there is already fill present in sheet 3, because my I dont want the format from sheets 1 and 2 to overwrite eachtoher.
Trying to delete the last two rows in a macro that formats the sheets in a specific way. Everything else works fine except the last two rows of the data do not get deleted
My entire code is:
Sub Format()
'Firstly convert all text cells into number cells for every sheet in workbook
Application.ScreenUpdating = False
For Each ws In Sheets
On Error Resume Next
For Each r In ws.UsedRange.SpecialCells(xlCellTypeConstants)
If IsNumeric(r) Then r.Value = (r.Value) * 1
''Or test the values in the next column on the right
'If IsNumeric(r) Then r.Offset(0,1).Value = (r.Value)*1
Next r
'Remove excess columns and rows
Dim lastRow As Long
'Find last row in column A
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'Remove Last 2 rows with data
ws.Rows(lastRow - 1 & ":" & lastRow).Delete
'Delete rows and columns
ws.Rows("1:15").Delete
ws.Columns("A").Delete
Next ws
Application.ScreenUpdating = True
End Sub
this is the code I'm trying to use to delete the last two rows in each sheet:
Dim lastRow As Long
'Find last row in column A
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'Remove Last 2 rows with data
ws.Rows(lastRow - 1 & ":" & lastRow).Delete
I have two questions
How to combine data using two of the cells from workbookA and copy to workbookB on the same cell?
How do I start using for loop to copy it until the last row/column?
I have no clue on how to combine the data and I do not know where to place the variable inside the code for it to loop until its last column.
Dim Tlastrow As Integer
Tlastrow = Cells(1, Columns.Count).End(xlToLeft).Column
For r = 1 To Tlastrow
Workbooks("InputB.xls").Worksheets("HC_MODULAR_BOARD_20180112").Range("F3:G3").Copy _
Workbooks("Output.xls").Worksheets("Sheet1").Range("I3")
Next
Try this:
Option Explicit
Sub Paste()
Dim wsInput As Worksheet, wsOutput As Worksheet, LastRow As Long, C As Range
Set wsInput = Workbooks("InputB.xls").Worksheets("HC_MODULAR_BOARD_20180112")
Set wsOutput = Workbooks("Output.xls").Worksheets("Sheet1")
With wsInput
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row 'Last Row with data
For Each C In .Range("F3:F" & LastRow) 'loop for every row with data
wsOutput.Cells(C.Row, "I").Value = C & " " & C.Offset(0, 1)
Next C
End With
End Sub
This code is assuming you want to paste every row from your input workbook to the output workbook on the same rows, but merging F and G columns. It's just pasting the values, not formulas or formats.
Hi guys I'm doing a course for Udemy and the lecturer unfortunately has not been the most responsive.
I have a workbook called QuarterlyReport and 5 sheets.
East Records
West Records
North Records
South Records
Yearly Report
My code formats the Worksheets 1-4 and then copy pastes the information to Yearly Report on the last unused row. For some reason, the code is only pasting South Records. My goal is to copy every single sheet 1 - 4 and paste it onto the fifth sheet "YEARLY REPORT".
Public Sub Finalreportloop()
Dim i As Integer
i = 1
Do While i <= Worksheets.Count - 1
Worksheets(i).Select
AddHeaders
FormatData
AutoSum
' copy the current data
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Copy
' select the final report WS'
Worksheets("yearly report").Select
'find the empty cells
LastRow = Sheets(i).Range("A" & Sheets(i).Rows.Count).End(xlUp).Row
'paste the new data in
ActiveSheet.Paste
i = i + 1
Loop
End Sub
The Addheaders, FormatData and AutoSum are in reference to other Modules I've created. Thank you everyone!
The code determines the last row of the sheet that you are copying from, but you don't do anything with that information. Instead, it just pastes into the active sheet and overwrites the data posted in the last loop instance. Hence it looks as if it is only copying/pasting the last data set.
You need to find the last row in the Yearly sheet, then paste the data below that.
You coudld try one of the methods below:
Option Explicit
Sub test()
Dim ws As Worksheet
Dim wsLastRow As Long, wsLastColumn As Long, yrLastRow As Long
Dim rngCopy As Range
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "YEARLY REPORT" Then
With ws
'Method 1 - You can siply used range
' .UsedRange.Copy
'Method 2 - You can calculate LastColumn & LastRow and create the range
wsLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<- Find last row of column A.
wsLastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column '<- Find the last column of row 1.
Set rngCopy = .Range(Cells(1, 1), Cells(wsLastRow, wsLastColumn)) '<- Create the range to be copy.
rngCopy.Copy
End With
With ThisWorkbook.Worksheets("YEARLY REPORT")
yrLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<- Find last row of column A.
.Range("A" & yrLastRow + 1).PasteSpecial xlPasteValues
End With
End If
Application.CutCopyMode = False
Next ws
End Sub
If a cell in column E = "Y", then I want to copy that cell's entire row into Sheet 2, and do this for each worksheet in the workbook, except Sheet 2.
Here's the code I've tried.
Sub Macro1()
Dim lastrow As Long
Dim cpyrow As String
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Sheet2" Then
For Each cell In Range("E:E")
If cell.Value = "Y" Then
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1
cpyrow = cell.Row & ":" & cell.Row
ws.Range(cpyrow).Copy Destination:=Sheets("Sheet2").Range("A" & lastrow)
End If
Next cell
End If
Next ws
End Sub
Sometimes it will copy the correct row, but other times it will copy rows whose cell in column E doesn't equal "Y", or it will skip over rows that do. Also why does it give different results when I run it while I'm on different sheets? Shouldn't it run the same and go through every worksheet?
You missed a parent sheet reference on the loop:
For Each cell In Range("E:E")
Should be
For Each cell In ws.Range("E:E")
Other wise you are testing the active sheet but copying the correct sheet on that row.
replace:
For Each cell In Range("E:E")
with:
For Each cell In ws.Range("E:E")
(there may be other errors)