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.
Related
VBA checking for value (shell-ID) from Sheet1 and Sheet2.
So, I am a complete beginner to VBA. Yet, I have been trying to figure out the code for this using various internet sources. So my idea for this is that i have two sheets of data (say sheet1 and sheet2). Sheet1 is the master list and sheet2 has all the major data. Now, my main conditions are that if the Shell-ID of a specific row in sheet1 matches the Shell-ID in sheet2, then just update the phase of the project. But if the value does not exist, then copy other columns like name of the project, project description, phase of the project etc. for that corresponding shell-ID back into sheet1 from sheet2.
So far, I can only make the entire row copied onto the sheet but not specific parts that I require. Here is my code and what I have tried. Any help will be appreciated.
Edit: for some reason I cannot attach files to stack (dont know if its possible to be honest) but I have added the pictures for the sheet
Sub Copying()
'defining the variables
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, fn As Range, sr As Range, rng As Range, n As Long
Dim i As Long, j As Long
Set sh1 = Sheet1
Set sh2 = Sheet2
Application.ScreenUpdating = False
'counting the number of rows in sheet 1
With Worksheets("Sheet1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
'gives you the number of rows
MsgBox ("Sheet1 has " & lr & "rows")
'counting rows for sheet2
With Worksheets("Sheet2")
j = .Cells(Rows.Count, 1).End(xlUp).Row
End With
'gives the number of rows for sheet2
MsgBox ("Sheet2 has " & j & "rows")
'checking the value from sheet2 vs sheet1 for shell ID #, if not present then it will copy the entire row
For i = 2 To j
With Worksheets("Sheet2")
If .Cells(i, 1).Value <>
Worksheets("Sheet1").Cells(i, 1).Value Then
.Rows(i).Copy
Destination:=Worksheets("Sheet1").Range("A" & lr)
lr = lr + 1
ElseIf .Cells(i, 1).Value =
Worksheets("Sheet1").Cells(i, 1).Value Then
End If
End With
Next i
MsgBox ("Copying complete")
End Sub
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.
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)
my questing is about trying to copy and paste 4 rows (4-7) under each row for the entire sheet, maybe using loop. I have pasted the copied rows under row 8 & 13 as an example (I would like to be able to do that for the remaining sheet until the rows are empty). Your expertise is greatly appreciated.
enter image description here
To implement:
Create a second sheet (in my code, referenced as Sheet2)
Paste the rows on this sheet that are to be inserted on the first sheet
Run Macro
Option Explicit
Sub EnterRows()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update
Dim i As Long, LR As Long, myRange As Range
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set myRange = ThisWorkbook.Sheets("Sheet2").Range("1:4")
Application.ScreenUpdating = False
For i = LR To 2 Step -1
myRange.Copy
ws.Range("A" & i + 1).Insert xlDown
Next i
Application.ScreenUpdating = True
End Sub
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