How can I set variable in Range? This is my code:
Sub Makro1()
Dim value As String
ThisWorkbook.Sheets("Arkusz1").Activate
ThisWorkbook.Sheets("Arkusz1").Range("R3").Select
value = ThisWorkbook.Sheets("Arkusz1").Range("R3").value
ThisWorkbook.Worksheets("Arkusz1").Range("C:value").Select '<--- Here is the BUG
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
For ranges the format is:
startColumn & StartRow & ":" & EndColumn & EndRow
EndColumn and EndRow are optional is not specified then they will be the same as Startcolumn and StartRow
for example to reference a range from column A, row 1 to Column D, Row 20 use:
sAddress = "A1:D20"
Untested
Consider:
Sub Makro1()
Dim valuee As String
ThisWorkbook.Sheets("Arkusz1").Activate
ThisWorkbook.Sheets("Arkusz1").Range("R3").Select
valuee = ThisWorkbook.Sheets("Arkusz1").Range("R3").value
ThisWorkbook.Worksheets("Arkusz1").Range("C" & valuee).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Related
I'm setting up a pricing model and am wondering how I am able to get the macro to run the pricing loan by loan and have the output pasted in a separate tab (this would also be loan by loan, so it cannot overwrite). I used the macro recorder and this is what I have so far, but I'm a novice and not sure how to loop this until it hits a blank cell (I did the first two loans....)
Sub Macro1()
'
' Macro1 Macro
'
'
Selection.Copy
Sheets("Cashflows").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Input").Select
Range("A3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Cashflows").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
The tools you need:
To figure out the last row:
Dim LastRow As Integer
LastRow = Range("A" & Rows.Count).End(xlUp).Row
'This simulates selecting the last cell in "A" Column,
'hitting "End" and "Up Arrow", then returns that row number
'as in integer.
To cycle through each row:
Dim I As Integer
For I = 1 To 10 '(Or replace "10" with "LastRow")
'Do something like look at a range value:
Debug.Print Cells(I, 1).Value
Next I
Finally, this is going to be a lot easier if you use .value = .value instead of copying and pasting:
Dim RowNum As Integer
RowNum = 10
Range("A1").Value = Range("B1").Value 'Copies Value from B1 into A1
Cells(1, 1).Value = Range("B1").Value 'Does Exact same thing as above: Cells(row, column)
'Copy A10:C10 from sheet2 to sheet1:
Sheet1.Range("A" & RowNum & ":C" & RowNum).Value = Sheet2.Range("A" & RowNum & ":C" & RowNum)
See how far you get with that and come back if you have more specific questions.
There are lots of good resources out there if you're having trouble.
I'm trying to create a Match macro that compares two lists and gives me the cells that present in only one of the lists. The cells are then copied to another sheet where the cells are counted. However, the blank cells are also being copied and I don't know why.
The below is what I have:
Sub Macro_do_Match()
Dim CopyrangeB As String
Dim lRowB As Integer
Dim fRowB As Integer
Dim CopyrangeD As String
Dim lRowD As Integer
Dim fRowD As Integer
Dim rng As Range
' Defines range for column B
lRowB = Cells(Rows.Count, 1).End(xlUp).Row
fRowB = 2
Let CopyrangeB = "B" & fRowB & ":" & "B" & lRowB
' "macro"
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IF(NOT(ISERROR(MATCH(C[-1],C[1],0)))=FALSE,C[-1], """")"
Range("B2").Select
Selection.AutoFill Destination:=Range(CopyrangeB)
' Defines range for column D
lRowD = Cells(Rows.Count, 3).End(xlUp).Row
fRowD = 2
Let CopyrangeD = "D" & fRowD & ":" & "D" & lRowD
' "macro"
Range("D2").Select
ActiveCell.FormulaR1C1 = _
"=IF(NOT(ISERROR(MATCH(C[-1],C[-3],0)))=FALSE,C[-1], """")"
Range("D2").Select
Selection.AutoFill Destination:=Range(CopyrangeD)
'Copy and paste B
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Final Results").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Copy and paste D
Sheets("Insert Lists").Select
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Final Results").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Public Sub CopyPaste()
Dim j As Long
For j = 2 To 52
Range("AE" & j).Select
Selection.Copy
Range("AE" & j).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("AF" & j).Select
Selection.Copy
Range("AF" & j).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("AG" & j).Select
Selection.Copy
Range("AG" & j).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next j
End Sub
Is there any way to minimize this code. I have tried using Range("AE:AG" & j).Select, but it showing some error.
Yes, it is.
If you want to paste only values you can equals ranges values. But you need to use cells and exact sheet object. For example
Public Sub CopyPaste()
Dim ws As Worksheet
Set ws = ActiveSheet
ws.Range(ws.Cells(2, 31), ws.Cells(52, 34)).Values = _
ws.Range(ws.Cells(2, 31), ws.Cells(52, 34)).Values
Set ws = Nothing
End Sub
It's always best to avoid using Select, Copy and Paste. You can almost always use .Value = ... in their place.
Assuming this is what you want to do (it isn't too clear from your question), if you ever want to replace a formulated cell with its value you can just set its value to itself:
Sub RemoveFormulas()
With ActiveSheet
.Range(.Cells(2, 31), .Cells(52, 34)).Value = _
.Range(.Cells(2, 31), .Cells(52, 34)).Value
End With
End Sub
I have been tasked with extracting data out of an Excel sheet that is strangely/poorly formatted. There is far too much data to manually copy out, so I am trying to use a Macro. I am not very skilled with VBA, but I know a little (probably just enough to break something :) ).
I am just working on 1 sheet right now, but there are several sheets, all formatted in the same way. Here is a snippet of what the source data looks like:
I highlighted the cells that I am needing to copy. The rest of the data is not important and won't need to be extracted.
As you can see, the source data is not formatted as traditional rows and columns, to say the least.
I am copying this data into a table that I have set up in a new sheet.
****Edit:**** I updated my code. I realized that the data was formatted to where there are the same amount of spaces between the rows in the data that I need, 14 to be exact. I now have a Do While Loop that increments the Row Index by 14 each time to move to the next record.
This code works, but am I going about this the correct way??? I will need to repeat this process for about 50 sheets, some of which have 1000 or more records.
Sub CopyData()
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
Dim DestRow As Long
Dim i As Integer
i = 0
Set SourceSheet = Sheets("Sheet1")
Set DestSheet = Sheets("Data")
Do While i < 100
DestRow = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
SourceSheet.Cells(2 + i, 1).Copy
DestSheet.Range("A" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(2 + i, 2).Copy
DestSheet.Range("D" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(3 + i, 2).Copy
DestSheet.Range("E" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(4 + i, 2).Copy
DestSheet.Range("F" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(2 + i, 7).Copy
DestSheet.Range("C" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(5 + i, 7).Copy
DestSheet.Range("G" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SourceSheet.Cells(14 + i, 2).Copy
DestSheet.Range("B" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
i = i + 14
Loop
End Sub
Yes, I think what you are doing is good. You've figured out the pattern and how to increment through it. You probably want to add some kind of check for when you've reached the end of a sheet - the simplest would be to test for a blank in the first line after the Do and exit that loop with an Exit Do which will kick you into an outer loop like For each ws in wb.Worksheets.
This isn't a very technical answer I know, but it seems like you're very close and I didn't want to type all this in a comment.
I am posting the almost final code I came up with here in case it can help any one in the future. It turned out to not be quite as hard as I thought, once I discovered there was equal spacing in the data. Thanks #Doug Glancy for your advice on using Exit Do.
I am sure this is far from a perfect solution. Need to add some error handling/checking. I would appreciate any advice on ways that the code could be improved, or different ways to accomplish this.
Sub CopyData()
Dim DestSheet As Worksheet
Dim DestRow As Long
Dim i As Integer
Set DestSheet = Sheets("Data")
'Loop through all worksheets in the workbook
For Each Worksheet In ActiveWorkbook.Worksheets
'Reset counter variable for each worksheet
i = 0
'Check to make sure we are not on the destination sheet
If Worksheet.Name <> DestSheet.Name Then
'Loop through all rows in the sheet
Do While i < Worksheet.Rows.Count
'Check the contents of the first row in the record to ensure that it contains data
If Worksheet.Cells(2 + i, 1) <> "" Then
'Find the next empty row in the destination sheet to copy to
DestRow = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
'Copy and paste data, using paste special because of the formatting and formulas in the source
Worksheet.Cells(2 + i, 1).Copy
DestSheet.Range("A" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(2 + i, 2).Copy
DestSheet.Range("D" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(3 + i, 2).Copy
DestSheet.Range("E" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(4 + i, 2).Copy
DestSheet.Range("F" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(2 + i, 7).Copy
DestSheet.Range("C" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(5 + i, 7).Copy
DestSheet.Range("G" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheet.Cells(14 + i, 2).Copy
DestSheet.Range("B" & DestRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Add 14 to counter, since the rows are equally spaced by 14
i = i + 14
Else
'If the first row contains no data, then exit the loop
Exit Do
End If
Loop
End If
Next
End Sub
This sub is set up to copy info over from one worksheet and paste the values into a new CSV workbook. I keep getting a runtime error on the pastespecial, however, it's only on the first click after opening the spreadsheet, if I click it again it works perfectly. And even though it gives me an error, when i click end it still pastes the values over.
Sub export_save()
Dim nrows As Integer
Dim norders As Integer
Dim i As String
Dim cell As Range
Dim fname As String
Dim WS As Worksheet
Dim WK As Workbook
Set WK = Workbooks.Add
Dim k As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
k = 2
i = "DO" 'plant to plant movement
'name new file
On Error GoTo canceled
fname = InputBox("Please name the new file, exlude any filename extensions.", "Export Data")
WK.SaveAs Filename:="S:\Active Customers\Teknor Apex\Feeds\Orders\" & fname, _
FileFormat:=xlCSV
MsgBox ("File saved to file path:S:\Active Customers\Teknor Apex\Feeds\dev\" & fname)
'copy info over
Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Activate
nrows = Rows(Rows.Count).End(xlUp).Row
Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Range("A3:AG" & nrows).copy
WK.Activate
Range("A1:AG" & nrows).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'remove parentheses
norders = Rows(Rows.Count).End(xlUp).Row
Range("AI2").FormulaR1C1 = "=MID(RC[-14],FIND(""("",RC[-14],1)+1,3)"
Range("AI2").AutoFill Destination:=Range("AI2:AI" & norders), Type:=xlFillDefault
Range("AI2:AI" & norders).copy
Range("U2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Columns("AI:AI").Delete Shift:=xlToLeft
'remove ship paratheses in DO orders
For Each cell In Range("B2:B" & norders)
If cell.Value = i Then
Range("AI" & k).FormulaR1C1 = "=MID(RC[-13],FIND("" ("",RC[-13],1)+1,3)"
Range("AI" & k).copy
Range("V" & k).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
k = k + 1
Next cell
'delete extra column used to remove paratheses
Columns("AI:AI").Delete Shift:=xlToLeft
WK.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
canceled:
End Sub
For clarity's sake here is a smaller version containing only the error, which is in the pastespecial line.
Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Activate
nrows = Rows(Rows.Count).End(xlUp).Row
Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Range("A3:AG" & nrows).copy
WK.Activate
Range("A1:AG" & nrows).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Change:
Range("A1:AG" & nrows).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
To:
Range("A1:AG" & nrows).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Your code is missing Paste:=