I want to creat a Macro that looks down column H and selects 14 cells. It then copies them and pastes them via a "transpose paste", i.e they go from rows to columns in the next sheet. It then keeps on doing this until it has run out. This is my code so far:
Sub Macro5()
'
' Macro5 Macro
'
' Keyboard Shortcut: Ctrl+t
' Dim x as integer
' Dim y as integer
' x = 313
' y = x + 13
' Range("Hx:Hy").Select
Selection.Copy
Sheets("Sheet3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'x = x + 14
End Sub
It supposed to start at cell H313.
My problem is, evertime I run this it just copies whatever cell I've highlighted and pastes that in the next sheet, without selecting all the cells I want.
How do I fix this?
Rows starting with a ' are considered a comment and are ignored by VBA. Therefore your code that selects the range (Range("Hx:Hy").Select) is never executed.
The first line being executed is Selection.Copy that - you guessed it - copies the cell you currently selected :)
Besides you need to compute the range, as "Hx:Hy" will never be parsed to H313:H326.
Use Range("H"&x&":H"&y) or Range(Cells(x, 8), Cells(y, 8)).
Because you've 'commented out' your first portion of code the first line actually being run is
Selection.Copy
Which is why it's only copying what's highlighted. I think, if you uncomment everything, you've still got a couple of issues but I think your main issue is the line:
Range("Hx:Hy").Select
Should be something like:
Range("H" & CStr(x) & ":H" & CStr(y)).Select
Dim x as integer
Dim y as integer
x = 313
y = x + 13
Range("H" & CStr(x) & ":H" & CStr(y)).Select
Selection.Copy
Sheets("Sheet3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Related
So I have around 16.000 cells to copy from one column to another one. If I copy paste it, only the first 1000 cells get pasted, the lower i get in the sheet, the less cells get pasted.
I cannot move & replace the column itself aswell since I m getting the error "This can`tbe done on a multiple range selection".
How can I copy all the cells at once? Thanks in advance
So i solved it over a looped vba:
'
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+ΓΌ
'
For i = 1 To 36430
Range("L" & i).Select
Selection.Copy
Range("M" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next i
End Sub```
I don't understand why you would use a loop here so maybe I'm missing something. Additionally When moving data in vba it's faster to move arrays than to copy/paste the data. e.g. something like this should be faster:
Sub CopySelection()
Dim addr As String, ArrToCopy, TargetCell As String, Rw As Long, Cl As Long
addr = selection.Areas(1).Address(False, False)
ArrToCopy = Sheet1.Range(addr).Value2
TargetCell = InputBox("What is the target StartCell?") 'e.g. B5
Cl = Range(TargetCell).Column
Rw = Range(TargetCell).Row
With Sheet1
.Range(.Cells(Rw, Cl), .Cells(Rw - 1 + UBound(ArrToCopy, 1), Cl - 1 + UBound(ArrToCopy, 2))).Value2 = ArrToCopy
End With
End Sub
hope this helps.
the original dataset in Excel look like this:
But I want to transpose for example the cells A3:A4 to B4:C4. In Excel I only need to copy the cells and then right click in cell B4 and click on transpose the copy cell. But due to 100k rows, I need to find a good solution how to do that.
One problem is that between the cell, I have text contents like "first section", "second section", "third section", and I don't want to transpose it.
Means for the first section, it should only consider A3 and A4 and so on.
Here is the picture, how I it should be looks like.
[2
I record the macro, but I don't know where I should tell them with "IF-Clause" that it should only consider everything except the yellow cells.
Sub transponieren()
'
' transponieren Makro
'
'
Range("A3:A4").Select
Selection.Copy
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub
The 'test' you're probably looking for is the IsNumeric() test. The following code suggestion assumes your data is on Sheet1, and the numbers are actually numbers and not text. There's probably a more elegant solution, but this does work:
Sub transposeNumbers()
Dim c As Range, LastRow As Long, TopN As Long, LastN As Long
LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For Each c In Sheet1.Range("A3:A" & LastRow)
If IsNumeric(c.Offset(-1, 0)) = False Then
TopN = c.Row
Else
If IsNumeric(c.Offset(1, 0)) = False Or c.Row = LastRow Then
LastN = c.Row
Sheet1.Range(Sheet1.Cells(TopN, 1), Sheet1.Cells(LastN, 1)).Copy
c.Offset(0, 1).PasteSpecial Paste:=xlPasteAll, transpose:=True
Application.CutCopyMode = False
End If
End If
Next c
End Sub
I want to replace !R46C181 to !R46C182, etc. Everytime i launch my macros, since it will take new column(month)
Right now , every month i manually change via find/replace (181 to 182) to move it to the next month before launching my macros.
Is there a way to put some - Input box? Like i where i just place 182, and it will update everything to it
Here is the part of that code
Range("BD31").Select
ActiveCell.FormulaR1C1 = _
"=SUM('[sales.xlsm]Market Share'!R46C181)"
Range("BD32").Select
ActiveCell.FormulaR1C1 = _
"=SUM('[sales.xlsm]Market Share'!R47C181:R49C181)"
Range("BD33").Select
And here is full code:
Sub Auto_ship()
'
' Auto_ship Macro
'
' Keyboard Shortcut: Ctrl+l
'
Range("BD31").Select
ActiveCell.FormulaR1C1 = _
"=SUM('[sales.xlsm]Market Share'!R46C181)"
Range("BD32").Select
ActiveCell.FormulaR1C1 = _
"=SUM('[sales.xlsm]Market Share'!R47C181:R49C181)"
Range("BD33").Select
ActiveCell.FormulaR1C1 = _
"=SUM('[sales.xlsm]Market Share'!R50C181)"
Range("BD34").Select
ActiveCell.FormulaR1C1 = _
"=SUM('[sales.xlsm]Market Share'!R51C181:R52C181)"
Range("BC31").Select
Selection.Copy
Range("BD31:BD35").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("BD31:BD34").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("BG25").Select
Application.CutCopyMode = False
Range("BC30").Select
Selection.AutoFill Destination:=Range("BC30:BD30"), Type:=xlFillDefault
Range("BC30:BD30").Select
Range("BB3:BC3").Select
Selection.AutoFill Destination:=Range("BB3:BD3"), Type:=xlFillDefault
Range("BB3:BD3").Select
Range("BD3").Select
ActiveCell.FormulaR1C1 = "'Sep 2020"
Range("BE3").Select
Columns("BC:BC").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=0
End Sub
You can use a
Dim month As String
month =InputBox("My Month")
save it to a string and then concat with & eg
"=SUM('[sales.xlsm]Market Share'!R46C"& month
of cause better ways to do this,error check etc, just a quick one here
The solution below features and InputBox where you can enter a column either by number (like 182) or by its alphabetic ID (like "FZ"). The specified column will then be used to create the formulas your code needs.
Option Explicit
Sub Auto_ship()
' 102
' Keyboard Shortcut: Ctrl+l
' include apostrophes and exclamation point in the string:-
Const Source As String = "'[sales.xlsm]Market Share'!"
Dim C As Variant ' target column
C = InputBox("Enter a column ID (Number or letter):", _
"Target column", "FA")
If Len(C) = 0 Then Exit Sub ' blank to exit
If Not IsNumeric(C) Then C = Columns(C).Column
With Application
.DisplayAlerts = False
.AskToUpdateLinks = False
End With
Cells(31, "BD").Formula = "=SUM(" & Source & RangeName(C, 46) & ")"
Cells(32, "BD").Formula = "=SUM(" & Source & RangeName(C, 47, 49) & ")"
Cells(33, "BD").Formula = "=SUM(" & Source & RangeName(C, 50) & ")"
Cells(34, "BD").Formula = "=SUM(" & Source & RangeName(C, 51, 52) & ")"
Cells(31, "BD").Copy ' copy the formats from BD31 to Bd32:Bd35
Range("BD32:BD35").PasteSpecial Paste:=xlPasteFormats
' if you want the formatsd to be copied to the current column use this line instead:-
' Range(Cells(32, C), Cells(35, C)).PasteSpecial Paste:=xlPasteFormats
' why would you copy the values from BD31:BD34 to that same address ?????
' Range("BD31:BD34").Copy ' copy the values
' Range("BD31:BD34").PasteSpecial Paste:=xlPasteValues
' Range("BG25").Select ' what's the purpose of this serlection?
With Application
.DisplayAlerts = True
.AskToUpdateLinks = True
.CutCopyMode = False
End With
End Sub
Private Function RangeName(ByVal C As Long, _
ByVal Rstart As Long, _
Optional ByVal Rend As Long)
' 102
Dim Rng As Range
Set Rng = Range(Cells(Rstart, C), Cells(IIf(Rend, Rend, Rstart), C))
RangeName = Rng.Address
End Function
The exact range address is created by the function RangeName which takes 2 or 3 arguments: the column, the start row and the end row. The latter can be omitted if you want to specify a single cell. I use A1 notations instead of R1C1. That's a matter of preference in this case.
My code looks radically different from yours because I removing all Select statements. They serve no useful purpose. Excel knows perfectly well where its cells are once you tell it the coordinates.
The second half of your code didn't make sense to me. I couldn't fathom why you would want to copy BD31:BD34 to Bd31:Bd34 every month. I gave one example how you might use the column you enter to address different cells each month directly. For the rest of the code I urge you to continue removing all Select statements and just address each range directly as you instruct what is to be done with it.
I have a mix of codes I found that seemed to work but no longer does after changing a few things. I am trying to copy values from a range on one sheet ("Sheet1") and paste them transposed onto another ("Sheet2"). The catch is that I only want to paste them into the row that the value in column A equals the value in ("B2") on the same sheet. Also, this value will be repeated throughout column A, but I only need it to paste to the row between rows 11 and 29. Here is what I have so far:
Sub PasteData()
Range("O3:O44").Select
Selection.copy
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Unprotect ("Password")
Dim nRow As Long
Dim nStart As Long, nEnd As Long
For nRow = 11 To 29
If Range("A" & nRow).Value = Range("b2").Value Then
nStart = nRow
Exit For
End If
Next nRow
For nRow = nStart To 29
If Range("a" & nRow).Value <> Range("b2").Value Then
nEnd = nRow
Exit For
End If
Next nRow
nEnd = nEnd - 1
Range("A" & nStart & ":AP" & nEnd).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Worksheets("Sheet2").Protect Password:="Password", DrawingObjects:=True, Contents:=True, Scenarios:=False
Worksheets("Sheet3").Activate
Range("B13").Select
End Sub
I have noticed on your code that you have not referenced the sheet of Range("O3:O44"). So when you run the code, it will Select and Copy the Range("O3:O44")of the active sheet.
To avoid this confusion, avoid using .Select and .Activate as much as possible especially when dealing with multiple sheets. When referencing Ranges, always include the sheet you are targeting to.
So instead of:
Range("O3:O44").Select
Selection.Copy
Do it like this:
Worksheets("Sheet1").Range("O3:O44").Copy
Now to answer your problem, you need to indicate what sheet Range("O3:O44") is from.
Then move this code on the line just before pasting it.
'range to copy with sheet reference
Worksheets("Sheet1").Range("O3:O44").Copy
'range where previous range will be pasted, also with sheet reference
Worksheets("Sheet2").Range("A" & nStart & ":AP" & nEnd).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Upon trying your code, this is the solution to the error you encounter.
I am trying to copy the same row of information from a sheet called "Report" (numbers will change), and paste the values into a sheet "Data" that has headers in the first row.
I tried piecing together some code from various questions.
Here is my code:
Sub Insert_Data()
'
' Insert_Data Macro
Sheets("Report").Range("B9:F9").Copy
Sheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub PSData_Transfer()
Sheets("Report").Range("B9:F9").Copy
Dim lastrow As Long
lastrow = Sheets("Data").Range("A65536").End(xlUp).Row
Sheets("Data").Activate
Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
You may have to modify this a little bit to work with your code, but feel free to use mine that I'm using in my current worksheet and it works perfect!
Sub Insert_Data()
For R = LR To 2 Step -1 ' Change the 2 in "To 2" to the row just below your header,
' but typically row 2 is the second cell under header anyways
Call CopyTo(Worksheets(2).Range("B" & R & ":C" & R), Worksheets(1)Range("A:B"))
Next R
End Sub
Private Function CopyTo(rngSource As Range, rngDest As Range)
LR = rngDest.cells(Rows.Count, 1).End(xlUp).row
rngDest.cells(LR + 1, 1).value = rngSource.cells(1, 1).value
rngDest.cells(LR + 1, 2).value = rngSource.cells(1, 2).value
End Function
I don't like to use the copy method as it's slow and it likes to copy all the extra jargin, where as getting the value is much faster and it's retrieving ONLY the value