I am working on VBA code that will run through a dropdown menu in Sheet "voorblad".
For every value in the dropdown menu I want to copy the value "Voorblad".range"K9" and "Calculation".range"G35" and paste it in a sheet called "LIST Sheet".
The VBA is meant to create a list of all the values.
Sub CreateList()
Dim Answer As VbMsgBoxResult
Answer = MsgBox("Validation message!", vbYesNoCancel, "CreateList")
If Answer = vbYes Then
Application.ScreenUpdating = False
With Sheets("Voorblad").Range("K9").Validation
For Each rCell In Range(.Formula1)
.Parent.Value = rCell.Value
Sheets("Voorblad").Select
Range("K9").Select
ActiveCell.Copy
Sheets("LIST Sheet").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("LIST Sheet").Select
ActiveCell.Offset(1, 0).Select
Sheets("Calculation").Select
Range("G35").Select
ActiveCell.Copy
Sheets("LIST Sheet").Select
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("LIST Sheet").Select
ActiveCell.Offset(1, 0).Select
Next rCell
.Parent.Value = ""
End With
Application.ScreenUpdating = True
MsgBox "Export geslaagd! Het PDF is opgeslagen in jouw Documenten"
End If
End Sub
The VBA code is not creating a list. Every time the macro runs through the code it will reselect the pre-selected cells at Range("B2") and Range("G2"). I want it to paste the values one row down. Eventually this must create a list.
To create the list properly, you need to ensure you are moving to the next empty cell on the target worksheet (List Sheet). Try something like
Sheets("LIST Sheet").Range("G2").End(XLdown).Offset(1,0).PasteSpecial Paste:=xlPastValues
This should put the value in the next blank cell. Same with column G
HTH
Related
Title isn't the best so here a an overview.
I'm using VBA to copy select columns from one workbook to another, as what will be part of a larger automated program.
On the Workbook I am copying from, there are different sheets containing a "Stock Number" column. When pasting into my other workbook, I am trying to get these columns to merge into 1 single column (pasting below the last entry from the first sheet and so on).
Here is my current code:
Sub import_adam_article()
Windows( _
"copyfrom.xlsx" _
).Activate
Columns("F:G").Select
Selection.Copy
Windows("pasteinto.xlsx").Activate
Columns("A:A").Select
ActiveSheet.Paste
Windows( _
"copyfrom.xlsx" _
).Activate
Columns("N:N").Select
Application.CutCopyMode = False
Selection.Copy
Windows("pasteinto.xlsx").Activate
Columns("C:C").Select
ActiveSheet.Paste
Rows("1:1").Select
Selection.Delete Shift:=xlUp
NextRow = Range("A1").End(xlDown).Row + 1
Windows( _
"copyfrom.xlsx" _
).Activate
Columns("F:G").Select
Selection.Copy
Windows("pasteinto.xlsx").Activate
Range("A" & (NextRow)).Select
ActiveSheet.Paste
[A:C].Select
With Selection
.NumberFormat = "General"
.Value = .Value
End With
End Sub
The difficulty is that the amount of Stock Numbers will change every new file that comes through, so it needs to be able to adjust to varying amounts.
I can't seem to find a way to make it work and I've tried searching for answers elsewhere.
EDIT: The current issue with the code that it is selecting the next empty row to paste into, but only that cell, not a variable length down as required by the copyfrom column.
I have an Export to sheet button but I can't get it working correctly.
I selects the correct cells to copy but can't then transpose them on to selected sheet that appears in the drop down box in cell A1, I then also need it to paste on the next available row in that specific sheet. The problem is that I can't just list the sheets in VBA as the list in the drop down box changes. I have tried several ways to with no success. If someone could help it would be great
Sub Button2_Click()
Worksheets("Sheet1").Range("a2:x2").Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet1!A1").Range("a:x")
End Sub
Here is some more code I have tried for the issue but still does not seem to work.
Sub ExportButton1()
'
' ExportButton1 Macro
' Exports Data to staff sheet from drop down box
'
' Keyboard Shortcut: Ctrl+e
'
ActiveWorkbook.Save
End Sub
Private Sub CommandButton1_Click(ByVal Target As Range)
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Data")
'On Error Resume Next
'If Not (Application.Intersect(Range("H2"), Target) Is Nothing) Then _
Set pasteSheet = Worksheets(ActiveSheet.Range("H2"))
copySheet.Range("G5:AA5").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
you need to change the sheet name in your worksheet function.
This might work.
Sub Button2_Click()
'Copying the Data
Worksheets("Sheet1").Range("a2:x2").Copy
'Pasting the data
' What we were missing was to pass the name of the tab dynamically. Now this code will pick up the name that appears in the Cell A1.
ActiveSheet.Paste Destination:=Worksheets(Worksheets("Sheet1").Range("A1").value).Range("A1")
End Sub
Also in the paste range you only need to put the first cell range to paste values.
To paste the Transposed Values check the function PasteSpecial with Transpose property set to True.
'I have found another way around the problem to copy paste cells to certain sheet then on 'staff sheet a formula in a table to tests column A value on data sheet for name and only 'transpose those rows
Sub Macro1()
Range("A2:J2").Select
Selection.Copy
Sheets("Sheet3").Select
Range("A60000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
End Sub
'Formula on staff sheet is -=IF(Sheet3!A:A="Column1",Sheet3!$B:$B,"")
Friends, I'm very poor in programming but maybe someone is willing to help.
My spreadsheet contains 18 ranges and 2 different headers in protected area. I need to copy and combine 1 header and 1 range to another, unprotected area. User should press a button and macro brings data to new position where it can be pasted.
For button operation I have an application.caller for hiding and showing rows. I think this is a good start. I also have a copy macro for 1 set of ranges. I'd like to combine these 2 in to a new macro.
Sub Macro_copy_RIVA1()
Range("RHEAD").Copy
Range("RIVA1").Copy
Application.Goto Reference:="R1120C2"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Cut
End Sub
My application caller for hide/show rows is (thanks to Stackoverflow)
Sub ShowHideRows()
Dim arr
'split the calling button name into an array
' (array will be zero-based)
arr = Split(Application.Caller, "_")
'**EDIT** check array is expected size...
If UBound(arr) <> 3 Then Exit Sub
If IsNumeric(arr(1)) And IsNumeric(arr(2)) Then
With ActiveSheet ' "Me" if the code is in the sheet module, else "ActiveSheet"
.Unprotect Password:=""
'arr(1) determines start row
'arr(2) determines # of rows
'arr(3) determines if rows are hidden or not
.Cells(arr(1), 1).Resize(arr(2), 1).EntireRow.Hidden = (arr(3) = "H")
.Protect Password:=""
End With
End If
End Sub`
My ranges are called :
Header:
RHEAD1
RHEAD2
Ranges:
RIVA1
RIVA2
RIVA3
.....
RIVA6
RMVA1
RMVA2
.....
RMVA12
Proposed name of button : btn_RHEAD1_RIVA1 or btn_RHEAD2_RMVA12
How can I run a macro from an application caller that performs the copying task ?
Thanks
First thing I did was create a button that would copy certain cells using this code:
Worksheets("Sheet1").Range("A:A,B:B,D:D").Copy _
and it worked fine.
Second, I found the code that would copy all details in a row based on the criteria of one, in this case if there was an "A" in the "Location" column.
Private Sub ENTIREROW_Click()
'Sub copyrows()
Dim i As Range, Cell As Object
Set i = Range("D:D") 'Substitute with the range which includes your True/False values
For Each Cell In i
If IsEmpty(Cell) Then
Exit Sub
End If
If Cell.Value = "A" Then
Cell.ENTIREROW.Copy
Sheet2.Select 'Substitute with your sheet
ActiveSheet.Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
My question is, how do I copy all information in the specified columns (A,B,D) where there is an "A" in "Location" in one button.
Furthermore, this is my example data, the sheet I will actually use this on has 34 columns to copy. Is there a more efficient way of setting a range when you don't want an entire sequence, everything but the data in column C?
Thanks in advance and apologies for my explanation skills.
One way maybe to:
filter your source
hide column C
copy the result using .PasteSpecial xlPasteValues into the destination
Unhide column C on the source sheet
remove the autofilter
Using xlPasteValues only pastes the visible cells from the source - so no column C
The code then looks like this: .
Sub CopyRows()
With Sheets(1).Range([A2], [A2].SpecialCells(xlLastCell))
[A1].AutoFilter
.AutoFilter Field:=4, Criteria1:="A"
[C:C].EntireColumn.Hidden = True
.Copy
[C:C].EntireColumn.Hidden = False
End With
With Sheets(2)
If .Cells(Sheets(2).Rows.Count, 1).End(xlUp) = "" Then 'it's a clean sheet
.Cells(Sheets(2).Rows.Count, 1).End(xlUp).PasteSpecial Paste:=xlPasteValues
Else
.Cells(Sheets(2).Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With
Application.CutCopyMode = False
Sheet1.[A1].AutoFilter
End Sub
I would like to set up some code for copying some cells with check boxes
I have 30 checkboxes
I have copied the code below and modified it 30times
This is no doubt redundant
Each check box is on a row, the data it will copy is on the same row
When the checkbox is clicked the row data in the next cell will be copied and moved somewhere else
This data will be dumped somewhere below in the same worksheet
I tried creating the elseif statements, unfortunately they did not work
If ThisWorkbook.Worksheets(1).Shapes("Check Box 2").OLEFormat.Object.Value = 1 Then
Range("f2").Select
Selection.Cut
Sheets("Sheet1").Select
Range("f15").Select
ActiveSheet.Paste
Range("f15").Select
Selection.Insert Shift:=xlDown
End If
End Sub
If ThisWorkbook.Worksheets(1).Shapes("Check Box 3").OLEFormat.Object.Value = 1 Then
Range("f3").Select
Selection.Cut
Sheets("Sheet1").Select
Range("f15").Select
ActiveSheet.Paste
Range("f15").Select
Selection.Insert Shift:=xlDown
End If
End Sub
If ThisWorkbook.Worksheets(1).Shapes("Check Box 4").OLEFormat.Object.Value = 1 Then
Range("f4").Select
Selection.Cut
Sheets("Sheet1").Select
Range("f15").Select
ActiveSheet.Paste
Range("f15").Select
Selection.Insert Shift:=xlDown
End If
End Sub
It is very repetitive as you can see
Any advice on how I can write this code so it will be like a nested if statement
if checkbox 1 is true do this
if checkbox 2 is true do this
etc etc
[IMG]http://i44.tinypic.com/2db78dj.jpg[/IMG]
please advise thank you
Without knowing a little more about the workbook structure, this is the best I can come up with. THere is likely some sort of "relationship" between the CheckBoxes and the cell(s) that need to be operated on, which could allow you to use a formula or some other logic to determine the cells to cut/paste, rather than relying on If/Then or Case logic.
Sub Test()
Dim cb As Shape
Dim cutRange As Range
'## The destination doesn't change, so we put this outside the loop
' also make it a constant value:
Cosnt destRange As String = "F15"
'## Now, iterate over each checkbox control in the sheet:
For Each cb In ActiveSheet.Shapes
'## Make sure the shape is an xlCheckBox AND value = True/checked
If cb.FormControlType = xlCheckBox And cb.OLEFormat.Object.Value = 1 Then
'## Assign the cutRange based on the CheckBox name
Select Case cb.Name
Case "Check Box 2"
Set cutRange = Range("F3")
Case "Check Box 3"
Set cutRange = Range("F4")
Case "Check Box 4"
Set cutRange = Range("F5")
'etc.
'## You can add as many Case values as you need
End Select
'## One statement cuts & inserts:
cutRange.Cut Range(destRange)
Range(destRange).Insert Shift:=xlDown
End If
Next
End Sub