Is there any way to get the value of a cell that is connected to a SpinButton and to determine the number of times a data will be copied.
For example everytime you press the Left or Right Button it will subtract or add a value with a minimum of 1 and maximum of 1000.
This is my code so far in copying data.
Range("D3:D10").Copy
Worksheets("Sheet2").Range("A2").PasteSpecial , Transpose:=True
The range of the cell that is associate in the SpinButton is "G7"
I want to get the value of that cell G7 to determine how many times it will copy the data from range D3 to D10.
The values is on "Sheet1". I want it to be pasted on "Sheet2".
Assuming the active sheet has the G7 and range to copy
Range("D3:D10").Copy
Worksheets("Sheet2").Range("A2:A" & 2 + [G7].Value).PasteSpecial , Transpose:=True
Application.CutCopyMode = False
Edit: paste to first available cell in sheet2
-
Sub Copy_Trspose()
Dim LstRw As Long, pRng As Range, cRng As Range, x
Dim sh As Worksheet, ws As Worksheet
Set ws = Sheets("Sheet2")
Set sh = Sheets("Sheet1")
Application.ScreenUpdating = False
With sh
Set cRng = .Range("D3:D10")
x = .Range("G7").Value
End With
With ws
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
Set pRng = .Range(.Cells(LstRw, "A"), .Cells(LstRw + x, "A"))
End With
cRng.Copy
pRng.PasteSpecial , Transpose:=True
Application.CutCopyMode = False
End Sub
Related
i am stuck with my procject again... I tried with formulas but i can t make it work or i can t make it right, and i couldn t find similar topic any where, here is the problem. As u can see in screenshot in this link https://ibb.co/FJRBxcM i have 2 worksheets, Sheet1 with some value generator, and Sheet"RadniNalog" where i copy&paste manualy certan values from Sheet1. My goal is to make it work automatically, when i paste data from another Workbook, as shown in screenshot example, i polulate range "A10:C27", range width is constant, always 3 column, but rows can change so number is X. Now i need values from "A10:A27" to copy to next empty column from left to right in Sheet"RadniNalog" from cells in 2nd row. Next i also need to copy Value from cell =F$13$ into the first row in sheet "RadniNalog" (on screenshot example its cell "E1" and that value from F13 needs to act like a Header for values belove it. If Value from header is the same as value in cell "F13" i need to continue adding values under existing ones, and if not move to the next available column. In screenshot example, if cell "D1" from sheet "RandiNalog" is same as cell "F13" in Sheet1, then values from range "A10:A27" should be added under last value in ColumnD. I need some VBA code if possible to make it work as wanted. Thanks in advance
Copy this code to Sheet1 module
This code runs the macro copyValuesToWs when you put the code in F13
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F13:G13")) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Call copyValuesToWs
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
Create a new module and insert this code
Option Explicit
Function FindLastRow(ByVal Col As Byte, ws As Worksheet) As Long
FindLastRow = ws.Cells(Rows.Count, Col).End(xlUp).Row
End Function
Function FindLastColumn(ByVal rw As Byte, ws As Worksheet) As Long
FindLastColumn = ws.Cells(rw, Columns.Count).End(xlToLeft).Column
End Function
Sub copyValuesToWs()
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Radni nalog")
Dim lCol As Long
Dim lRow As Long
Dim srcRng As Range
Dim dstRng As Range
Dim hdRng As Range
' Next row after ID
Dim idRng As Range: Set idRng = ws1.Range("A10")
' find last row value in column A
lRow = FindLastRow(1, ws1)
' range to be copied
Set srcRng = ws1.Range(ws1.Cells(idRng.Row, 1), ws1.Cells(lRow, 1))
' find last used column in sheet2
lCol = FindLastColumn(1, ws2)
' header range
Set hdRng = ws2.Range(ws2.Cells(1, 1), ws2.Cells(1, lCol))
' check if value exists in header
On Error Resume Next
Dim sValue As Double: sValue = Application.WorksheetFunction.Match(ws1.Range("F13").Value, hdRng, 0)
If Err.Number = 0 Then ' value exists
' find last row
Set dstRng = ws2.Cells(FindLastRow(sValue, ws2) + 1, sValue)
' paste values
srcRng.Copy
dstRng.PasteSpecial xlPasteValues
Else
' set destination range
Set dstRng = ws2.Cells(2, lCol + 1)
' set header value
ws1.Range("F13:G13").Copy
ws2.Cells(1, lCol + 1).PasteSpecial xlPasteValues
' paste values
srcRng.Copy
dstRng.PasteSpecial xlPasteValues
End If
On Error GoTo 0
Application.CutCopyMode = False
End Sub
I am trying to loop through a range of cells and copy and paste the values of the ones that are not blank or do not contain an "X" (as well as the cell two to the right of it) to columns on another worksheet. I am hoping that the cells I paste them to will retain the pre-formatted conditional formatting set up prior to having stuff pasted to them. What I have so far is not working, and does not account for the cell two adjacent to the copy cell or just pasting the value without formatting. It would be great if then I could sort the first of the pairs of cells by alphabetically (also not accounted for). Thanks for any help!
Sub Wire_List_Export()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim c As Range
Dim j As Integer
Set copySheet = Worksheets("LV Schedule")
Set pasteSheet = Worksheets("test")
For Each c In copySheet.Range("G274:G10000")
If Not c = "X" Or Not IsEmpty(c) Then
copySheet.Cells(c).Copy pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next c
End Sub
Is this what you are looking for?
Sub Wire_List_Export()
'Declarations.
Dim RngCopyRange As Range
Dim IntOffsetCopy As Integer
Dim RngPasteRange As Range
Dim RngCell As Range
'Turning off screen updating.
Application.ScreenUpdating = False
'Setting variables.
Set RngCopyRange = Worksheets("LV Schedule").Range("G274:H10000")
Set RngPasteRange = Worksheets("test").Range("A1:B9727")
'Copying the range.
RngCopyRange.Copy
'Pasting the range (only values, skipping blank cells).
RngPasteRange.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=True, _
Transpose:=False
'Turning off cut-copy mode.
Application.CutCopyMode = False
'Turning on screen updating.
Application.ScreenUpdating = True
End Sub
I'm trying to write a macro to copy the contents of cell A1 of sheet wsVN to the first open cell in column F of sheet wsVL, then copy A2 to the next open cell in F, then A3 to the next and so on up to A305. Sheet VL has a header row with the first open cell being F2. That's where I'm trying to past A1. Then I have a couple rows with data then another open cell where I'd like to past A2. Then 5 rows of data before the next open cell where A3 should go. Here is as close as I have made it so far:
Sub Data_Transfer()
'
' Data_Transfer Macro
' Transfers VariableNames Data to the next available row of sheet VariableList.
Dim lastRow As Integer
Dim wsVN As Worksheet
Dim wsVL As Worksheet
Dim sourceRange As Range
Dim targetRange As Range
Set wsVN = Worksheets("VariableNames")
Set wsVL = Worksheets("VariationList")
If Len(wsVL.Range("F1").Value) > 0 Then
lastRow = wsVL.Range("F2").End(xlDown).Row
Else
lastRow = 2
End If
Set sourceRange = wsVN.Range("A1")
Set targetRange = wsVL.Range("F" & lastRow).Offset(1, 0)
sourceRange.Copy
targetRange.PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Hopefully someone will offer some guidance on this. It would be appreciated very much!
Thanks
Try this, adjusting sheet names to suit.
Sub x()
Dim r As Range
With Worksheets("Sheet1") 'source sheet
For Each r In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
Worksheets("Sheet2").Range("F:F").SpecialCells(xlCellTypeBlanks)(1).Value = r.Value 'destination sheet
Next r
End With
End Sub
More on SpecialCells.
Does anyone know what other command I need to use to copy the row label "Total WI Expenses" down 4 rows below?
The following code will find the "Total WI Expenses" and copy it to a range, however, I just want to find the total and copy the data to the 4 rows down. They need to be copied and pasted as values.
Sub Test()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim rw As Long, Cell As Range
For Each Cell In ActiveSheet.Range("B:B")
If Cell.Value = "Total WI Expenses" Then
Cell.EntireRow.copy
Range("A71").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End If
Next
End Sub
I sincerely appreciate your assistance.
Instead of running a For loop over the whole(!) column you may check first, if something is in the column, and then .Find the wanted value. If you found a result, then you may use it's row number.
Instead of Copy/Paste you may just assign the Range.Value to get the values without formatting.
This code copies the whole row's values four rows below.
Sub Test()
Dim ws As Worksheet
Dim c As Range
Set ws = ActiveSheet
If WorksheetFunction.CountA(ws.Columns(2)) > 0 Then
Set c = ws.Columns(2).Find( _
What:="Total WI Expenses", _
After:=ws.Cells(1, 2), _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not c Is Nothing Then
ws.Rows(c.Row + 4).Value = ws.Rows(c.Row).Value
End If
Set c = Nothing
End If
Set ws = Nothing
End Sub
I need to copy data from one worksheet into another. However, I need a conditional copy operation that will skip rows based on criteria.
For example, if I start with...
Active Value
yes 1
no 2
no 3
yes 4
no 5
no 6
I only want to copy rows that are Active=yes, so I would end up with...
Value
1
4
Can someone show me how this is done with 1) a macro and 2) a formula?
Formula approach:
suppose your data are in sheet1, range A2:B7.
Then use this formula in sheet2 cell A2:
=IFERROR(INDEX(Sheet1!B:B,SMALL(IF(Sheet1!$A$2:$A$7="yes",ROW(Sheet1!$A$2:$A$7)),ROW()-ROW($A$2)+1)),"")
with array entry (CTRL+SHIFT+ENTER) and then drag it down.
VBA approach:
You can use AutoFilter:
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, rngToCopy As Range
Dim lastrow As Long
'change Sheet1 and Sheet2 to suit
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
With ws1
'assumung that your data stored in column A:B, Sheet1
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A1:B" & lastrow)
'clear all filters
.AutoFilterMode = False
With rng
'apply filter
.AutoFilter Field:=1, Criteria1:="yes"
On Error Resume Next
'get only visible rows
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
'copy range
If Not rngToCopy Is Nothing Then rngToCopy.Copy Destination:=ws2.Range("A1")
'clear all filters
.AutoFilterMode = False
End With
Application.CutCopyMode = False
End Sub
Note, if you want to copy only Value column, change
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
to
Set rngToCopy = .Offset(, 1).Resize(, .Columns.Count - 1).SpecialCells(xlCellTypeVisible)
It's easy enough with a macro. Assuming you're copying from the first sheet to the second sheet, and that your sample above is in columns A and B, you could do the following:
Public Sub ConditionalCopy()
Dim copyRng As Range
Set copyRng = Worksheets(1).Range("B2:B7")
Dim pasteRng As Range
Set pasteRng = Worksheets(2).Range("A2")
Dim i As Long
i = 0
For Each cell in copyRng.Cells
If cell.Offset(0, -1).Value2 = "yes" Then
pasteRng.Offset(i,0).Value2 = cell.Value2
i = i + 1
End If
Next cell
End Sub
Doing it with a formula presents a challenge in terms of not leaving any blank rows on the second sheet. It would be pretty trivial to just use the following in the second sheet:
=If(A2 = "yes",b2,"")
And copy that down, but you're going to end up with blank rows that you'll have to go back and delete yourself. If you have the ability to use the macro, it's straightforward enough that I would go that route rather than sinking too much effort into devising a formula. The more I think about it, the more I feel like it has to be a programmatic solution to avoid double references.
If you use seperate counters for the source and destination rows, and use cell references rather than ranges the following routine should do the trick
Public Sub copyactivevalue()
Dim i As Integer
Dim j As Integer
Dim acts As Excel.Worksheet
Dim news As Excel.Worksheet
Set acts = Excel.Worksheets("sheet1")
Set news = Excel.Worksheets("sheet2")
With acts
j = 2
For i = 2 To 7
If acts.Cells(i, 1).Value = "yes" Then
news.Cells(j, 1) = acts.Cells(i, 2).Value
j = j + 1
End If
Next
End With
Set acts = Nothing
Set news = Nothing
End Sub
Hope this helps