I have a problem with pasting columns
Set SourceWBsht = Thisworkbook.Worksheets("Source")
Set DestinationWBsht= Thisworkbook.Worksheets("Destination")
SourceWBsht.Range("A1:Z40").EntireColumn.Copy
DestinationWBsht.Range("A1:Z40").EntireColumn.PasteSpecial _
Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
SourceWBsht.Range("A1:Z40").EntireRow.Copy
DestinationWBsht.Range("A1:Z40").EntireRow.PasteSpecial _
Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
The problem is VBA activating the destination sheet automatically, Somehow, I am trying to avoid it. Any ideas?
Thanks.
You can try something like this:
DestinationWBsht.Range("A1:Z40").value = SourceWBsht.Range("A1:Z40").value
Edit 1: After Comment
SourceWBsht.Range("A1:Z40").Copy
DestinationWBsht.Range("A1:Z40").PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Related
I am trying to figure this out and I am hoping you can help
Basically I have Form and Data Sheet. I am looking to copy the information in the form into a new blank row within Table1 on the data sheet,
I have managed to get as far as the following but this causes the data to be over written each time, (rather than a a new row).
Sub Macro1()
Sheets("Form").Select
Range("G5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[ID]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("D3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Contact Date]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("D4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Channel]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Agent Name]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("D6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Contact ID]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("G3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Scored by]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("G4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Team Leader]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I realise this may seem like a simple question but I am struggling to work this out.
FYI - There will be 29 Columns to this table so If I should be doing something to make this cleaner, please let me know
Here's a more streamlined way to approach this:
EDIT - updated to add "config" array to reduce repetition
Sub Transfer()
Dim config, itm, arr
Dim rw As Range, listCols As ListColumns
Dim shtForm As Worksheet
Set shtForm = Worksheets("Form") '<< data source
With Sheets("Data").ListObjects("Table1")
Set rw = .ListRows.Add.Range 'add a new row and get its Range
Set listCols = .ListColumns 'get the columns collection
End With
'array of strings with pairs of "[colname]<>[range address]"
config = Array("ID<>G5", "Contact Date<>D3", "Channel<>D4")
'loop over each item in the config array and transfer the value to the
' appropriate column
For Each itm In config
arr = Split(itm, "<>") ' split to colname and cell address
rw.Cells(listCols(arr(0)).Index).Value = shtForm.Range(arr(1)).Value
Next itm
End Sub
No copy/paste/select/activate required.
I'm working on a business case with a growing number of scenarios, I could do all these in scenario manager but that's not convenient right now.
What I'm trying to do is the following: I've got a list of names for the given scenarios, these should be pasted to an input field which then runs the scenario, the results should then be copied to a location specified for that scenario.
The current code does it without any issues but it feels 'sluggish' to me because I need to make a different block of code for each scenario:
Sheets("Output").Select
Range("G7").Select
ActiveCell.FormulaR1C1 = "All stores"
Sheets("Stuurgroep").Select
Range("N4:N18").Select
Selection.Copy
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Output").Select
Range("G7").Select
ActiveCell.FormulaR1C1 = "Quartile 1"
Sheets("Stuurgroep").Select
Range("N4:N18").Select
Selection.Copy
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
In which G7 is the place for the scenario, "all stores" in this case is the first scenario, N4:N18 are the results of that scenario and C4 is the place for those results, with the results of the next scenario being pasted into D4.
I've tried the following code to create the list to paste into G7 but it doesn't work:
Set ListScenarios = ActiveWorkbook.Sheets("RefTables").Range("B3:B11")
For Each cell In ListScenarios
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Range("G7").Select
ActiveSheet.Paste
Sheets("Stuurgroep").Select
Range("N4:N18").Select
Selection.Copy
Call Paste
Next cell
Sub Paste()
Set Destination = ActiveWorkbook.Sheets("Stuurgroep").Range("C4:K4")
For Each cell In Destination
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next cell
Help would be much appreciated!
A few times a day I receive a file. I'm trying to automate it as much as possible and one part would include having the macro that lets you select a file to vlookup into (the file name is different every time). My macro runs, but for some reason it prompts you to select your file 3 times. I've tried a few variations on the code, but nothing worked. Does anyone have any insight as to why? It is prompting once when first opening the file, once when filling in the first cell with the formula, and again when the macro fills down column with the vlookup formula. I've pasted the relevant part below:
Dim MyFile As String
MyFile = Application.GetOpenFilename
Set firstWB = ActiveWorkbook
Set mySheet = ActiveSheet
Set wbLookup = Workbooks.Open(MyFile)
firstWB.Activate
mySheet.Range("T2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-18],'[wbLookup]tempemail'!R2C2:R123C20,19,0)"
Range("S1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Columns("t:t").EntireColumn.AutoFit
Columns("T:T").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
wbLookup.Close False
Range("U1").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("U1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("u:u").EntireColumn.AutoFit
End Sub
Thanks!
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-18],'[wbLookup]tempemail'!R2C2:R123C20,19,0)"
This will not work unless wbLookup is literally the name of your file. Excel sees this and prompts you for the actual name.
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-18],'[" & wbLookup.Name & "]tempemail'!R2C2:R123C20,19,0)"
might work better
This:
Columns("T:T").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
...could be replaced by this:
Columns("T:T").Value = Columns("T:T").Value
A lot of selecting/activating is unneeded and is better avoided: How to avoid using Select in Excel VBA
Why can´t my code below paste values only?
The result is pastes the formula instead of the value.
Can anyone help?
Please check my code as follow :
Sheets("Invoice Print").Activate
Range("F21:F27").Select
Selection.SpecialCells(xlCellTypeFormulas, 1).Select
Selection.Copy
Sheets("Outgoing Goods").Select
Cells(Rows.Count, 1).Range("K1").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Are there any mistakes?
PS: I'm using Excel 2013.
Please advise.
Thank you.
You overwrite the pasted values right in the next line with ActiveSheet.Paste
Also you should not use .Select and Selection..
Sheets("Invoice Print").Range("F21:F27").SpecialCells(xlCellTypeFormulas, 1).Copy
With Sheets("Outgoing Goods")
.Cells(.Rows.Count, 1).Range("K1").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'This line would overwrite the pasted values with not explecit values only
'ActiveSheet.Paste
Application.CutCopyMode = False
End With
Hope I could help.
Probably pretty straightforward - was hoping for some help. I have a 36x36 matrix that quantifies various gasoline grade relative values to other gasoline grades. I would like to write a loop that takes each row and moves it to another worksheet (in consecutive order), without having to copy and paste the same code over and over again (changing the range and sheet). Appreciate any help.
Sheets("Formulas").Range("Z8:BI8").Copy
With Sheets("CONV7.8RVP87OCT").Range("A10000").End(xlUp).Offset(1, 0)
.PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Sheets("Formulas").Range("Z9:BI9").Copy
With Sheets("CONV7.8RVP89OCT").Range("A10000").End(xlUp).Offset(1, 0)
.PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Sheets("Formulas").Range("Z10:BI10").Copy
With Sheets("CONV7.8RVP93OCT").Range("A10000").End(xlUp).Offset(1, 0)
.PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Sheets("Formulas").Range("Z11:BI11").Copy
With Sheets("CONV9.0RVP87OCT").Range("A10000").End(xlUp).Offset(1, 0)
.PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Sure. You just want to send the worksheet to a subroutine as a parameter.
Private sub pasteFormula(ws as WorkSheet)
With ws.Range("A10000").End(xlUp).Offset(1, 0)
.PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End sub
Called like:
dim ws as WorkSheet
Set ws = Sheets("CONV7.8RVP87OCT")
Sheets("Formulas").Range("Z8:BI8").Copy
pasteFormulas(ws)
' next worksheet
Set ws = Sheets("CONV7.8RVP89OCT")
Sheets("Formulas").Range("Z9:BI9").Copy
pasteFormulas(ws)
' etc...
' You might actually want to consider a for worksheets loop, but I'll leave that as an exercise for you to complete.
See also Avoid Using Select for a pretty good description of how to use the Worksheet object as a variable.
How about this?
You'll need to define your destination sheet names e.g. "CONV9.0RVP87OCT", "CONV7.8RVP87OCT" in the array:
Sub CopyRows()
Dim sheets() As Variant, sourceData As Range, rw As Long
Set sourceData = Worksheets("Formulas").Range("Z8:BI43") // your 36 x 36 matrix
sheets = Array("Sheet2", "Sheet3") //add your sheet names in here...
For rw = 1 To sourceData.Rows.Count
sourceData.Rows(rw).Copy Destination:=Worksheets(sheets(rw - 1)).Range("A10000").End(xlUp).Offset(1, 0)
Next rw
End Sub