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.
Related
I want to do lookup in a specified range(rows X to AF in "main" tab[Sheet1]) which I am doing using VBA hlookup function. The problem I am facing is that I am not able to do this lookup in a loop, which means once the hlookup is done in X2:AF2, then it should do the calculation in X3:AF3 for next row.
I need to do this because the Tablehandle[sheeet2] result will change every time (macro will clear this sheet) and the headers will not in order.
So can someone help me to get hlookup in a loop for a specified row?
My "Main" sheet
"TableHandle" sheet
Option Explicit
Sub hlookup1()
Dim i, r As Long
For i = 1 To Range("K100000").End(xlUp).Row - 1
'first macro will get the table inside sheet ...
Sheets("TableHandle").Select
'Range("A2").Select
'Range(Selection, Selection.End(xlDown)).Select
'Range("A2:B10").Select
'Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'hlookup
Sheets("Main").Select
Range("X2").Select
Range("X" & i + 1).Select
ActiveCell.FormulaR1C1 = "=HLOOKUP(R1C,TableHandle!R1C6:R2C14,2,0)"
Selection.Copy
Range("X2:AF2").Select 'PROBLEM from Here, it will again calculate in x2 to af2 range)
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
i = i + 1
Next
End Sub
Yours is a good idea but in practice it has a number of drawbacks as demonstrated by the error handling you had planned. I think you would also have to replace the formulas you insert with so much effort with the values they produce. Please try this code instead. It transfers data from the TableHandler sheet to the Main without the use of worksheet formulas.
Sub hlookup1()
' 211
Dim Data As Variant ' source data
Dim Headers As Range ' column captions in 'Main'
Dim Fnd As Range ' Find the column caption
Dim Rs As Long ' Row: Source (= 'Data')
Dim Cs As Long ' Column: Source
Dim Rt As Long ' Row: Target
Dim Ct As Long ' Column: Target
'first macro will get the table inside sheet ...
With Worksheets("TableHandle") ' data source
Rs = .Cells(.Rows.Count, "A").End(xlUp).Row
Data = .Range(.Cells(2, "A"), .Cells(Rs, "X")).Value
' Row 1 of 'Data' holds the column headers because
' SheetRow(2) became the ArrayRow(1)
End With
Application.ScreenUpdating = False ' speed up execution
With Worksheets("Main")
Set Headers = .Range("A2:X2")
' start in array row 2 because array row 1 holds the column captions
For Rs = 2 To UBound(Data) ' loop through all rows
Rt = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
For Cs = 1 To UBound(Data, 2) ' loop through the columns of each row
Set Fnd = Headers.Find(Data(1, Cs), LookIn:=xlValues, lookat:=xlWhole)
If Not Fnd Is Nothing Then ' skip column not found
.Cells(Rt, Fnd.Column).Value = Data(Rs, Cs)
End If
Next Cs
Next Rs
End With
Application.ScreenUpdating = True
End Sub
If a column in the TableHandler should not be found the macro will not transfer data, leaving the target column blank. If you want a warning it would have to be added. There is a little confusion in your question as to rows and columns. Should I have guessed wrongly here or there I trust you will be able to make the required modifications. However, you are welcome to ask for help, too.
it was important and i spent all day to make this possible, i ans my question here.
the code is shortned as below, it works fast and efficient. thanks for suggestions!
Dim Hlookp As Variant
Hlookp = Application.HLookup(Range("B1:J1").Value, Sheets("TableHandle").Range("F1:N" & Cells(Rows.Count, 1).End(xlUp).row), 2, False)
Range("B" & i + 1 & ":J" & i + 1).Value = Hlookp
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 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
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