Paste data from different sheets to one sheet (one after the other) - excel

I'm trying to join the information of different sheets, into only one sheet. In my code, i first create a variable j that will have the value of a cell in Sheets("Folha2") (this cell only count how many rows are filled in the first column of the Sheets("Folha1"), to understand in which line can i start to paste the data from another sheet). So i only paste the data from the sheet "Portugal" to Sheet "Folha1", and after i try to paste the data from the sheet "Itália" starting in cells( j, 1).
The error is
Method or data member not found
What did I do wrong?
Sub Macro2()
Dim j As Integer
j = Sheets("Folha2").Range("A1").Value + 1
Range(Sheets("Portugal").Range("A1"), Sheets("Portugal").Range("A1").End(xlToRight).End(xlDown)).Copy
Range(Sheets("Folha1").Cells(j, 1)).Paste
Range(Sheets("Itália").Range("A1"), Sheets("Itália").Range("A1").End(xlToRight).End(xlDown)).Copy
Range(Sheets("Folha1").Cells(j, 1)).Paste
End Sub

This might do it:
Sub Macro4()
Range(Sheets("Portugal").Range("A1"), Sheets("Portugal").Range("A1").End(xlToRight).End(xlDown)).Copy
Sheets("Folha1").Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(Sheets("Itália").Range("A2"), Sheets("Itália").Range("A2").End(xlToRight).End(xlDown)).Copy
Sheets("Folha1").Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

Not quite sure what you're doing, but if I'm right you can reduce your code to this:
Sub Macro2()
Dim j As Long
'j = Sheets("Folha2").Range("A1").Value + 1
Sheets("Portugal").Range("A1").CurrentRegion.Copy Sheets("Folha1").Cells(Rows.Count, 1).End(xlUp)(2)
Sheets("Italia").Range("A1").CurrentRegion.Copy Sheets("Folha1").Cells(Rows.Count, 1).End(xlUp)(2)
End Sub

Related

How to make a for loop faster in vba when copying pasting columns

I have a vba script that uses a for loop to copy rows to columns, but this method is very slow when running. Is there a faster way of accomplishing this.
As you can see below, I have data in the 'my data' row and I need each of the rows copied and pasted to the next column to the right. For example, the 1 needs to be copied and pasted all the way to the columns to the right from range(X44:AY44) and so on.
Below is the script that works, but it is too slow for processing.
Sub CopyPasteSV4_SV30()
Dim r As Range, cell As Range
Dim i As Integer
i = 44
For Each cell In Range("X44:X63")
Range("X" & i).Select
Selection.Copy
Range("Y" & i, Range("AY" & i)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
i = i + 1
Next cell
End Sub
There is no need to loop, use Select, or use .Copy/.PasteSpecial. Use value transfer.
Range("Y44:AY63").Value = Range("X44:X63").Value

VBA Left Function?

I'm relatively new to VBA and have some code I wrote that seems like it should be straightforward but is not behaving as expected. I am trying to separate my primary WorkSheet (GAWi) into three other worksheets (LWi, WMi, & OTi) based on the first letter in column H. Basically if the first letter is "L" I want that row to be copied and pasted onto sheet LWi and then deleted from the original sheet. Then if it is W it goes onto WMi and if it is A it goes onto OTi. It is functioning properly for the first two If statements (placing items that begin with L & W onto the correct sheets), but for the last one items that begin with P and 0 are also being placed onto sheet OTi. I'm at a complete loss, it seems pretty easy and I can't figure out where I went wrong. Any advice would be much appreciated, also I'm sure this code is pretty unelegant by most standards so any tips on how to shorten it would also be welcomed-I've just started getting into VBA in the last couple weeks. Thank so much!
Sheets("GAWi").Select
Columns("H:H").Select
Dim lwr As Range
Set lwr = ActiveSheet.UsedRange
For i = lwr.Cells.Count To 1 Step -1
If Left(lwr.Item(i).Value, 1) = "L" Then
lwr.Item(i).EntireRow.copy
Sheets("LWi").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(1, 0).Select
Sheets("GAWi").Select
lwr.Item(i).EntireRow.Delete
End If
If Left(lwr.Item(i).Value, 1) = "W" Then
lwr.Item(i).EntireRow.copy
Sheets("WMi").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(1, 0).Select
Sheets("GAWi").Select
lwr.Item(i).EntireRow.Delete
End If
If Left(lwr.Item(i).Value, 1) = "A" Then
lwr.Item(i).EntireRow.copy
Sheets("OTi").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(1, 0).Select
Sheets("GAWi").Select
lwr.Item(i).EntireRow.Delete
End If Next i
there's a main flaw in your logic: the use of UsedRange
despite being it a 2D range, its Item() property would act as if it were a 1D array with one row listed after another
so that were "A1:H10" (eight columns) the address of UsedRange, UsedRange.Item(1) would point to "A1", UsedRange.Item(8) would point to "H1" and UsedRange.Item(9) would point to "A2" …
so you have to loop through the cells of column H only
Then there's a coding flaw, which is the use of all those Select/Selection: get in the habit of always use explicit range reference qualified up to their parent worksheet and workbook
. This can be reached, for instance, with the use of With... End With construct
here's a possible code (explanations in comments):
Option Explicit
Sub TransferRows()
Dim i As Long
With Sheets("GAWi") ' reference "source" sheet
For i = .Cells(.Rows.Count, "H").End(xlUp).Row To 1 Step -1 ' loop backwards from referenced sheet column H last not empty cell row index to 1
Select Case UCase(.Cells(i, "H").Value) ' check for referenced sheet column H current row content
Case "L"
TransferRow Intersect(.UsedRange, .Rows(i)), Sheets("LWi") ' pass referenced sheet current row "used" range and "LWi" destination sheet to the helper sub
Case "W"
TransferRow Intersect(.UsedRange, .Rows(i)), Sheets("WMi") ' pass referenced sheet current row "used" range and "WMi" destination sheet to the helper sub
Case "A"
TransferRow Intersect(.UsedRange, .Rows(i)), Sheets("OTi") ' pass referenced sheet current row "used" range and "OTi" destination sheet to the helper sub
End Select
Next i
End With
End Sub
Sub TransferRow(sourceRng As Range, destSht As Worksheet)
With destSht
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, sourceRng.Columns.Count).Value = sourceRng.Value
End With
sourceRng.Delete xlUp
End Sub
As you see, other than the amendements due to the preface explanations I put in there:
the use of Select Case syntax instead of If Then End If
which I think is much clearer and would also correct a minor logic flaw of your orginal code: once a check is positive there's no need to run other ones (this you could have obtained by means of If - Then - ElseIf - Endif construct)
the use of a "helper" sub to demand the repetitive code to
which gives you much more control over your code and helps its maintenance
the use of Cells(Rows.Count, colIndex).End(xlUp) pattern
which is the most frequently used one to get the reference to the last not empty cell in some colIndex (be it a number or a letter) column
Thanks to HTH's great response I was able to clean up my code a bit and think I got it figured out. I opted to stick with the If Then Else If format since I am not too familiar with using Case yet. Here's the first section of it, I just repeated the copy, paste, delete row for each starting letter.
Set rng = Range("GAWi!H:H")
For k = rng.Cells.Count To 1 Step -1
If Left(rng.Item(k).Value, 1) = "W" Then
With rng.Item(k)
.EntireRow.copy
Sheets("WMi").Activate
ActiveCell.Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.EntireRow.Delete
End With
ElseIf Left(rng.Item(k).Value, 1) = "L" Then....
This is running well for my purposes but if anyone has more suggestions they are much appreciated.

VBA copying cell dependent on text to next blank cell on another worksheet

I created the below and i'm an absolute noob, i literally just pieced different bits of info together to get it working and it did, until i added the selecting the cell if it has 'r' in it and moving it to 'sheet7' and now i get an (object required) error when it runs.
I really need some help on this and if you are feeling generous, i would like to repeat the exercise with several other letters and sheets, so if you could demonstrate an additional one too, i'm sure i could work out the rest.
Thanks in advance
Sub Macro1()
'
' Macro1 Macro
'
'
Range("I16").Select
Selection.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
Application.CutCopyMode = False
Selection.Copy
Range("J20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-27
Range("I16").Select
If Cell.Value = "R" Then
Range("J20").Select
Selection.Copy
Sheets("Sheet7").Select
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
Generally when writing macros it's good practice to avoid selecting cells. Selecting a cell is really something that only a human does, but in VBA we can just refer to the cell directly without touching it.
Rewriting your macro to avoid all the touching:
Sub Macro1()
'Make a variable to store the cell found
Dim lastCell as Range
'find the last cell in Column A of the active sheet
lastCell = Range("A" & Rows.Count).End(xlUp).Offset(1)
'Paste in the I16 value
lastCell.value = RangE("I16").value
'Grab whatever is hanging out in Column B next to the last cell and stick it in J20
Range("J20").value = lastCell.Offset(0,1).value
'Test to see if I16 has value "R"
If Range("I16").value = "R" Then
'Find the last row in Sheet7, Column B and store it to the variable
lastCell = Range("B" & Rows.Count).End(xlUp).Offset(1)
'Copy J20 value to the lastCell in Sheet 7, Column B
lastCell = Range("J20").value
End if
End Sub
I'm not sure where you were getting the error you reported. It's probably specific to your workbook, so we'd have to be sitting in front of it to track it down. This rewrite may correct it though.
Also, it's not clear what else is happening in this process. My guess is that Column B of the Active Sheet has a formula in it that does something to the value we paste from I16. After it's pasted and calculated we grab that and stick it in J20 and if I16 is equal to "R" then we put that calculated J20 value over Sheet7. If that sounds about right, then the macro above should do the trick.
Also, if that IS what's happening, then perhaps you could share the formula you have in Column B. We can probable to do that calculation within VBA and save a ton of steps in this macro.

Macro to repeat itself on the next rown down

I have this macro which works ok on the first row, but once it has completed I want it to run again on the next row down and paste the result on the next row down on the "results" sheet and continue the process through the whole document until it reaches the last record - (there are approx. 5300 records in my spreadsheet)
Sub Macro2()
' Macro2 Macro
Range("A2:BW2").Select
Selection.Copy
Sheets("Lookup").Select
Range("F3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F3:V3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Result").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
So basically I am copying the first row of data on sheet named "amps_job_history", it them pastes this data into a sheet called "lookup", once the data is pasted there a formula does a calculation that marries the data up with data from another worksheet. I then want to copy the original data plus the extra 3 columns that have been connected to the data with the formulas and the paste it into the sheet called "result". I then want it to go back to the first sheet "amps_job_hisotry" move down to the next row of data and repeat the process and when it pastes the data into the "result" page it need to past on the next row down and so on and so on until it reaches the last record.
I think this loop is what you are looking for.
Sub Macro2()
' Macro2 Macro
Dim rw As Long
With Worksheets("amps_job_history")
For rw = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
With Intersect(.Range("A:BW"), .Rows(rw))
Worksheets("Lookup").Range("F3").Resize(.Rows.Count, .Columns.Count) = .Value
End With
With Worksheets("Lookup")
With .Range("F3:V3")
Worksheets("Result").Range("A1").Offset(rw - 1, 0).Resize(.Rows.Count, .Columns.Count) = .Value
End With
End With
Next rw
End With
End Sub
The rows from the source data in the amps_job_history and the destination Result worksheet are shifted down one more row on each loop. The transitional F3:V3 range in the Lookup worksheet remains the same through out.
I've use direct value transfer rather than copy, paste special, values and the With ... End With statement provide explicit parent worksheet referencing without the use of the Range .Select or Range .Activate methods.

Excel Macro to copy from sequential rows to constant location, then from constant location back to matching row

I'm making my first macro in order to save having to perform 2500 copy-pastes. I have a long and complicated worksheet that takes two variables as inputs and returns a single value, and another sheet with 2500 pairs of these variables.
To keep things in the same sheet, I've linked the formula sheet inputs to J2 and K2 on my variable sheet, and the output to L2. My goal is to populate a third column next to the first two with the results for that row, by copying the two values to J2 & K2, then copying from L2 to the appropriate cell in the third column. As my macro is currently, it returns to the same cell in the third column every time, based on an offset from L2 as the last active cell.
I've tried searching for help on how to either increment the last paste operation, or to keep the active cell referencing the start point of the macro in order to keep things in the same row, but was unsuccessful. Any help would be appreciated.
ActiveCell.Range("A1:B1").Select
Selection.copy
Range("J2:K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L2").Select
Application.CutCopyMode = False
Selection.copy
ActiveCell.Offset(43, -5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sub TT()
Dim sht As Worksheet, c As Range
Set sht = ActiveSheet
For Each c In sht.Range("A1:A2500").Cells
sht.Range("J2").Value = c.Value
sht.Range("K2").Value = c.Offset(0, 1).Value
sht.Calculate
c.Offset(0, 2).Value = sht.Range("L2").Value
Next c
End Sub

Resources