need to modify this code which currently pastes the current region to the specified page, to instead read the # of rows used on the sheet that is called, and then insert that number of rows before pasting the data. having issues if the sheet called is > 187 rows it will paste over existing data that it should not touch. need it to then reset when a new sheet is called to the pasting area
Dim wkSht As Worksheet
For Each wkSht In Sheets
'sheet6 is the DashboardMain sheet
If Sheet6.Range("E3").Value = wkSht.Name Then
wkSht.Range("A1").CurrentRegion.Copy Destination:=Sheet6.Range("A12")
End If
Next
Related
I have this problem with an excel file.
I have in this file 200 sheets in which always in the same cells (range O2:O6) I have certain values to copy in a unique sheet (named "Final") in the same column C.I
I would like also to order this values that I copy and paste; I would (maybe) use the command if else to understand the order: in fact in cell A1 of all the sheets there is the name of reference of that sheet (some sheets have name A, others B, others C);I must put in order in the sheet Final, before the values of sheets with name A then values with name B and then values of sheets with name C. so in practice I would do, "If (in the cell A1 of each sheet is present letter A) then (copy the relative values)"
then all values of sheets with name B in that cell, and then name C.
Could you help me?
This will get you started, it loops through the sheets and copies the range to "Final" sheet.
It does not copy the sheets in order, you can use my example and create a loop that will do that.
Sub Do_Something()
Dim sh As Worksheet
Dim ws As Worksheet
Set ws = Sheets("Final")
With ws
For Each sh In Sheets
If sh.Name <> ws.Name Then
sh.Range("O2:O6").Copy .Cells(.Rows.Count, "C").End(xlUp).Offset(1)
End If
Next sh
End With
End Sub
But my problem is the order, to copy is ok. i would want to copy that range but before from some sheet and then from others, regarding the name contained in that cell
I'm stuck on how to structure a piece of code that:
Loops through all worksheets that begin with the number 673: (e.g. 673:green, 673:blue)
Selects the data in these worksheets from row 5 up until the last row with data - code that works for this (generously provided by another user) is
Dim report As Worksheet
Set report = Excel.ActiveSheet
With report
.Range(.Cells(5, "K"), .Cells(.Rows.Count, "K").End(xlUp)).EntireRow.Select
End With
Select the "Colours" worksheet
Paste the rows at the next available blank row. There could be up to 40/50 worksheets which will have data pasted into the "Colours" worksheet so I need the data added to the next available line.
Thank you in advance.
Loop over the sheets in the workbook and check their names
For Each sheet in ActiveWorkbook.Worksheets
If Instr(sheet.Name,"673")>0 Then
...
End If
Next
Good, but you're going to want to copy.
Selection.Copy
Just select.
Worksheets("Colours").Select
Find the last row then go to the next. The row is found by finding the first populated row from the bottom up. Note I used explicit sheet references, which is unnecessary since you selected the sheet already. This is better form, however, if you will be manipulating data on multiple sheets in your code.
lastRow = Worksheets("Colours").Cells(Worksheets("Colours").rows.count,1).End(xlUp).Row
Worksheets("Colours").Cells(lastRow + 1, 1).Select
Activesheet.Paste
Project Master
In MS Excel using VBA, I would like some help on conditional copying between worksheets within the same workbook. As per the attached image, I have a master list of projects on the worksheet "Master". For all the projects that have a "yes" in column I (Defect), I would like to copy the values in columns A (Works Package Issue Date), B (Project No.), E (City) and H (Contract Value) to another worksheet "Defects", within the same workbook.
Can you please provide a coding which could:
a) collapse all the rows so there is no blank rows in "Defects" worksheet; and
b) leave all the rows so if the "Defect" column has a "No", the relevant row from the "Master" worksheet is copied as a blank row in the "Defect" worksheet,
if possible.
Please help me with the coding - I have very basic knowledge of macros, and in a process of learning how to code.
Thanks & Regards, CK
Sub CopyValues()
'Declare variables
'Declare sheet variables
Dim Masterws as Worksheet
Dim Defectws as worksheet
'Declare counter variables
Dim I as Integer
Dim n as Integer
'Set value of sheet variables
Set Masterws=ThisWorkbook.Sheets("Master")
Set Defectws=ThisWorkbook.Sheets("Defects")
'Set value of counter to track first available row on Defects sheet
n=1
'Start a For loop to check each row on Master sheet, starting with row 2
For I = 2 to WorksheetFunction.CountA(Masterws.Columns.EntireColumn(1))
'If the cells in row I, column I have a value of, "Yes," then execute some code. If not, continue on.
If Cells(I, "I").value= "Yes" Then
'Set the value of cells in row n of the Defects sheet to the corresponding values of row I in the Master sheet. If n is replaced with I, then the value of cells in row I on Defects will be set to the values of Row I on Master, leaving blank rows where no, "Yes," was found because no copying took place.
Defectws.Cells(n,"A").Value=Masterws.cells(I,"A")
Defectws.Cells(n,"B").Value=Masterws.cells(I,"B")
Defectws.Cells(n,"C").Value=Masterws.cells(I,"E")
Defectws.Cells(n,"D").Value=Masterws.cells(I,"H")
'Add 1 to the n counter. The next time a row is found in the Master sheet with, "Yes," it will be written to the next available row down on the Defects sheet.
n=n+1
End If
'End of the For loop. Move on to the next row on Master sheet
Next
End Sub
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
What would be the cleverst way of copy and pasting Excel-Tables from multiple files to one single file. So espacially how do I determine the Range of the used Rows for the copy and paste within the makro?
If this is a one time operation, probably the quickest way would be to activate the office clipboard (arrow in bottom right corner on Home tab). This allows up to 24 separate ranges to be collected and pasted below one another.
Assuming data is in one workbook and starts in row 2 on each sheet, as in the example below, you can:
Select all the tabs
Select all the rows on the first sheet
Press Ctrl+C, Ctrl+Page Down, repeatedly to copy all the data
Select a new sheet and click Paste All
Note that only the used range is copied so you can copy whole sheet ranges instead of needing to locate the last cell on each sheet.
If you really mean Tables you can reference them using the ListObjects collection.
Try this (code located in destination workbook)
This code copies all source tables as separate tables with a blank row between. If you want to merge the data into a single table you will need to copy lo.DataBodyRange rather than lo.Range and handle the header row and conversion to a table separetly.
Sub CopyTables()
Dim wbFrom As Workbook
Dim shFrom As Worksheet
Dim shTo As Worksheet
Dim lo As ListObject
Dim clTo As Range
' Setup Destination for copied tables
Set shTo = ThisWorkbook.Worksheets("DestinationSheet") ' <-- change name to your destination sheet name
' remove any existing data
shTo.UsedRange.EntireRow.Delete
Set clTo = shTo.Cells(1, 1)
' Loop through open workbooks
For Each wbFrom In Application.Workbooks
' except destination wb
If wbFrom.Name <> ThisWorkbook.Name Then
' loop through all sheets
For Each shFrom In wbFrom.Worksheets
' loop through all tables on sheet
For Each lo In shFrom.ListObjects
lo.Range.Copy clTo
' offset to next paste location, leave one empty row between tables
Set clTo = clTo.Offset(lo.ListRows.Count + 2, 0)
Next
Next
End If
Next
End Sub
Alternative inner For loop to paste to a single range
For Each lo In shFrom.ListObjects
lo.DataBodyRange.Copy clTo
Set clTo = clTo.Offset(lo.ListRows.Count, 0)
Next