My data range needs to be copied from one tab to another. The key to this is it needs to paste the information in the data range into a new row, even if the information is the same. So each time it is run a new row will be populated. Another key here is the row data range consists of criteria, depending on the value of criteria the code will decide which tab to copy into.
I was able to create the code to copy but without if statement and it copies into the same row each time
if Cell E3 = "Revenue" then copy into Revenue worksheet, if not then copy into Cost worksheet.
Each time code is run, the data will be copied into the last unoccupied row available in that worksheet
If I understood You right, this should work:
Sub copy2sheet()
Dim cond As String
Dim lastRow As Integer
With Sheets(ActiveSheet.Name)
'taking name of the sheet from "E3"
cond = .Range("E3").Value
'checking last filled row in sheet we gonna copy data
lastRow = Sheets(cond).Cells(Rows.Count, 1).End(xlUp).row
'copy data starting from "A1" to every cell is close to - CurrentRegion
'a paste it into first empty cell in column "A"
'.Range("A1").CurrentRegion.Copy Sheets(cond).Range("A" & lastRow + 1)
.Range("E3:H3").Copy Sheets(cond).Range("A" & lastRow + 1)
End With
End Sub
Related
I am trying to copy and paste data from the same column (A) in multiple sheets into a single column of a data in a final sheet.
The code I have used so far works perfectly if there is more than one row of data beneath the header row.
The sheet is formatted to include a table beneath the data and if there is only one row of data on the sheet the existing code will copy data from cell A2 to the first cell in the table with data (essentially performing ctrl+shift+down).
I need an if statement to count a range of data (could be A2:A3) and if the count is greater than 1 it would copy all the data down the column to first empty row. Then paste it to the first empty row in Column A of another sheet. Else copy cell A2 and then paste it to the first empty row in column A of another sheet.
Sheets("Sheet1").Select
If Range("A2:A3").Count > 1 Then
Range("A2",Range("A2").End(xlDown)).Copy Destination:=Sheets("QA").Range("A" & Rows.Count).End(xlUp).Offset(1)
ElseIf Range("A2:A3").Count = 1 Then
Range("A2").Copy Destination:=Sheets("QA").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
This will work. You really just need to check if A3 has data.
With Worksheets("Sheet1")
Dim source as Range
If Len(.Range("A3")) then
Set source = .Range(.Range("A2"),.Range("A2").End(xlDown))
Else
Set source = .Range("A2")
End If
End With
Dim dest as Range
Set dest = Worksheets("QA").Range("A" & Rows.Count).End(xlUp).Offset(1)
dest.Resize(source.Rows.Count,1).Value = source.Value
Sub Link()
Dim Turbidity As Long
Dim RawTurbidity As Range
'Sets variables Turbidity being the ActiveCell and RawTurbidity referring to the last captured cell in raw sheets'
Turbidity = ActiveCell.Row
Set RawTurbidity = Sheets("Raw Data").Range("C4").End(xlDown)
'The formula assigning the last captured cell in Raw sheets to the active cell '
Sheet1.Range(Sheet1.Cells(Turbidity, 4), Sheet1.Cells(Turbidity, 4)).Formula = RawTurbidity
End Sub
So this is the code I have and currently it does what it's suppose to do. We have two sheets atm sheet1 and Raw Data An instrument spits out data into column C of Raw data starting wtih C4 and going all the way down. The current code I wrote in essence paste the newest value the instrument spits out to the active cell in sheet1. I have a code on Raw Data that runs the macro only when a change is made to column C4 and lower. And it works exactly how I want it to however...
my question or issue is that when I add activecell.offset(1,0).select in order to have the activecell automatically go to the next row in sheet1 without me moving the mouse the macro copies and paste the same data into the next 4 cells. If I have the intrument spit out the data again than this time it occupies the next 6 rows with the same data.
Joe B, I think you are making this harder than it is.
Last value in a sheet column gets copied to the next open row in a specified column on another sheet? Is that right?
Option Explicit
Sub Link()
Dim ws1 As Worksheet
Dim wsRaw As Worksheet
Dim ws1LastRow As Long ' "Turbidity"
Dim wsRawLastRow As Long ' "RawTurbidity"
' I suggest you just name the sheets using the developer prop window
'It cuts this whole part out as you can call them directly
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
ws1LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 'lets say you are pasting to column A
'ws1LastRow = ws1LastRow + 1
'There you go the next writable cell row, this is wasted code though, see below you just increment when you need it
wsRawLastRow = wsRaw.Cells(wsRaw.Rows.Count, "C").End(xlUp).Row 'This method doesn't care if your data starts in C4
'No formula needed, it is a straight "copy" here, actually faster as its an assignment
ws1.Cells(ws1LastRow + 1, "A").Value = wsRaw.Cells(wsRawLastRow, "C").Value
'the next open cell (defined by row) in your sheet 1 column is equal to the last row of your Raw Data sheet column
End Sub
Issue is that the data in sheet one is not inputted in order. A person may need the data calculated to row 10 and the next calculation needs to be in row 20 hence the need to copy the data into the active cell.
This was my bad for not stating that in the initial post as it's the primary reason for this strange formula.
I have merged variable amount of worksheets which are called anything includes the word "data" through this code;
Dim masterSheet As Worksheet
Set masterSheet = Sheets("Komko")
'Variable to save the used Range of the master sheet
Dim usedRangeMaster As Integer
Dim ws As Worksheet
'loop through each worksheet in current workbook
For Each ws In Worksheets
'If sheetname contains "data" (UCase casts the Name to upper case letters)
If InStr(1, UCase(ws.Name), "DATA", vbTextCompare) > 0 Then
'calculate the used range of the master sheet
usedRangeMaster = masterSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
'Variable to save the used Range of the sub sheet
Dim usedRangeSub As Integer
'calculate the used range of the sub sheet
usedRangeSub = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'copy relevant range from the subsheet
ws.Range("C1:C" & usedRangeSub).Copy
'paste the copied range after the used range in column a
masterSheet.Range("A" & usedRangeMaster).PasteSpecial
End If
Next ws
This code copies the C column of the "data" including Sheets and then pastes it to my master Sheets( which is called "Komko") Column A. Now i would like identify the same values in Column C and delete the complete row of the previous matching value. (e.g if C1 has value "123" and if C7 has value "123" the whole row which includes C1 should automatically be deleted)
How can i do this ?
See http://analysistabs.com/vba/find-duplicate-values-column/ to find your duplicate entries and Delete a row in Excel VBA to get some ideas how to delete the row in a good way.
Start searching after you merged your column C. Use a Boolean variable to skip the first found entry if necessary. Replace the code Cells(iCntr, 2) = "Duplicate" from the first link and put your way of deleting the row there.
I know there's many StackOverlow Q&A's on copying & pasting from a cell value in VBA. However, I can't seem to make it work for my own project. I want to copy the entire row(s) if it matches the Distinct Store# (non incremental) in Column H into a new sheet (in this code below, "Sheet1") which already has a template layout where I copy/paste the values. The template looks the same on every sheet before any data is filled in, except the first 2 tabs which have the data ("Appointments" and "Invoices").
I came up with the VBA below, but here's the catch- the cell# that it pastes the row(s) (in the code below, "A10") changes based on the Store #. This is because I am copying rows from the 1st sheet ("Appointments") in the workbook from the distinct Store#, then deleting the empty rows above the area where the 2nd sheet ("Invoices") data goes. Some stores may return 10 rows or none at all. The Case, which is the Store #, is currently manually put in one by one. Should it be an array instead?
Anyway...I was hoping to automate the copying/pasting and loop for each store to their sheet. Maybe I'm going about this wrong, but would anyone be kind enough to suggest how to solve my error code "Method or data member not found." as well as provide any suggestions on making my code better for a loop for filtered cell copying to different spots for each sheet.
Simple explanation of my step by step process:
1.Filter Store # from "Appointments" sheet.
2. Copy all rows for that store and paste into a new sheet with template named "Sheet1" in B3.
3. Filter Store # from "Invoices" sheet.
4. Copy all rows for that store and paste into the previously made sheet named "Sheet" under the above rows. (Some stores do not have invoices, so this section is blank/NULL). Paste destination cell for "Invoices" will be different for each store# depending on how many rows they get from the "Appointments" sheet (could be A10 or A25).
5. LOOP- Next store #, next sheet (sheet2).
Sub CopyToNewSheetInv()
Dim i As Range
Dim book As Workbooks
Dim sheet1 As Worksheets
Dim sheet2 As Worksheets
Set book = Workbooks("SampleWorkbookName")
Set sheet1 = Worksheets("AllInvoices")
Set sheet2 = Worksheets("Sheet1")
For Each i In sheet1.Range("H:H")
Select Case i.Value
Case 1243
sheet2.Range("A10").End(xlUp).Offset(1, 0).EntireRow.Value = i.EntireRow.Value
Case Else
End Select
Next i
End Sub
Try this:
Sub CopyToNewSheetInv()
Dim i As Range
Dim book As Workbook
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set book = Workbooks("SampleWorkbookName.xlsx")
Set sheet1 = book.Worksheets("AllInvoices")
Set sheet2 = book.Worksheets("Sheet1")
'iterate only thorugh those cells in H that have data, not all 1.04 million
For Each i In sheet1.Range("H1", sheet1.Range("H" & sheet1.Rows.Count).End(xlUp))
Select Case i.Value
Case 1243,"1243"
sheet2.Rows(sheet2.Range("A10000").End(xlUp).Offset(1, 0).Row).Value = sheet1.Rows(i.Row).Value
Case Else
End Select
Next i
End Sub
My aim with this bit of code is to paste the contents of column D into a different Sheet if the contents in column N on the same row within the initial Sheet is = "REDUCE ONLY".
I'm struggling to find a way to paste all the entries into the second Sheet with no blank rows between them.
Currently I'm sorting the initial Sheet so all the REDUCE ONLY entries are in order at the top of the column N so they're ordered correctly in the output sheet but this isn't very robust if I get a different set of values to what's expected in column N. Is there a different way to phrase:
"cfdSht.Cells(c.Row - 1, 1).PasteSpecial Paste:=xlPasteValues"
So far I've got:
Dim c As Range
Dim rCheck As Range
Dim LRMAIN As Long
Dim cfdSht As Worksheet
Dim mainSht As Worksheet
Set mainSht = ThisWorkbook.Worksheets("Sheet1")
Set cfdSht = ThisWorkbook.Worksheets("ProductSettingNgCfd")
''Set Last Row
LRMAIN = mainSht.Range("A2").CurrentRegion.Rows.Count
''Set Range
Set rCheck = mainSht.Range("B2:N" & LRMAIN)
''Copy any value in column D where the value on the same row in column N is "REDUCE ONLY". Paste into second Sheet with starting point adjusted up 1 row.
For Each c In rCheck
If c.Value = "REDUCE ONLY" Then
mainSht.Cells(c.Row, 4).Copy
cfdSht.Cells(c.Row - 1, 1).PasteSpecial Paste:=xlPasteValues
End If
Next
Thanks
Replace this:
mainSht.Cells(c.Row, 4).Copy
cfdSht.Cells(c.Row - 1, 1)
With this
cfdSht.Cells(cfdSht.RowsCount, 1).End(xlUp).Offset(1).value = mainSht.Cells(c.Row, 4).Value
The first part will start at the bottom of the sheet then go up to the first occupied cell then move one down to the first unoccupied cell.
I used the direct assign method, because it is less taxing on the process than copy and paste. As you were looking only for values this will just put the value of the one cell into the other.