Copy and Paste Macro on loop within same sheet - excel

I am trying to copy cells B48:B52 and then paste in cells B55:B59, and then paste the same data again but with two rows in between (so now in cells B62:B66). Need to do this in a loop so that it pastes the range ~1100 times.
I'm sure there is a way to do this with VBA but cannot figure it out. Any helpers?

I think this is what you are looking for:
Sub paste_each_n()
t = 48
Count = 1
Do Until Count = 1100
Range("B" & t & ":B" & t + 4).Copy
Cells(t + 7, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues
t = t + 7
Count = Count + 1
Loop
End Sub

Related

How to move cells down its column based off blank cell row in range

I am trying to move cell values in columns K to L down within its column to the same row as every blank cell in column E.
Hopefully this makes sense but I think i need to figure out how to find each blank cell's row number and force it as a row variable i can then use to tell my code to move cell values in range K13:L. For example, if there's a value in K13:L14 and the blank cells in column E is E20 and E23, i want K13 and L13 to move to K20 and L20 while K14 and L14 move to K23 and L23.
The number of blank cells will always match however many cells with value are in column K/L
Would appreciate any help on this!
Use the macro below to start your studies. But first you need to remove the values in column K&L to N&O. (Maybe you can record a macro and add the recorded codes to the start of the codes below.)
Sub move_it()
i = 13
j = 13
Do While Cells(j, 14).Value <> ""
If Cells(i, 5) <> "" Then
i = i + 1
Else
Range("n" & j, "o" & j).Select
Selection.Cut
Range("K" & i).Select
ActiveSheet.Paste
j = j + 1
i = i + 1
End If
Loop
End Sub
The answer that was i needed to offset my copy paste by the rows i needed to move it to!
ws.Range("E" & openitemstartrow + 1, ws.Range("F" & openitemstartrow +
10).End(xlUp)).Copy
targetws.Range("G" & rows.Count, "H" & rows.Count).End(xlUp).Offset(1, 4).PasteSpecial Paste:=xlPasteValues

How to select data after autofilter? UsedRange.SpecialCells(xlCellTypeVisible) not working

I have a sheet of data. I apply the autofilter. Now, I want to copy and paste that particular data only the visible lines. I'm using the command UsedRange.SpecialCells(xlCellTypeVisible).Copy and it is now working. Is there any other way to do this? or a workaround?
this is my code
ws1.Activate
ws1.Cells(1, 1).Select
'to count how many lines are on the sheet
LastRow = ws1.Range("A1").CurrentRegion.Rows.Count
'lets use the last row to build the range that I need to filter
myrange = CStr(LastRow)
'I filter the range on the sheet by 0.14
ws1.Range("A1:O" & myrange).AutoFilter Field:=8, Criteria1:="0.14"
'this counts the data(rows) visible after applying the filter and -1 means minus the header
Rowz = ws1.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
'this will copy the filtered data into the following range
'I get the error in this line of code. dont know what wrong
ws1.UsedRange.SpecialCells(xlCellTypeVisible).Copy Range("A" & CStr(LastRow + 1) & ":O" & CStr(LastRow + 1))
'I tried as well
ws1.UsedRange.SpecialCells(xlCellTypeVisible).Copy Range("A" & CStr(LastRow + 1) & ":O" & CStr(LastRow + 1 + Rowz))
any ideas are welcome :)

Unable to Paste a column except 1st row in different excel workbook using excel vba

I am trying to do simple copy paste task of a range. I am looking for a match of header in two excel sheets and when match occur I am trying to copy that column except 1st row to the different excel with same sheet name. I am able to copy paste complete column but I don't want to copy 1st row which is header.
Please advice
Set Wb1 = Workbooks(Wb1name)
Sheetname = Wb1.ActiveSheet.Name
Set Wb2 = Workbooks("Worksheet2.xlsm")
'Find the last non-blank cell in row 1
l1Col = Wb1.Worksheets(Sheetname).Cells(1, Columns.Count).End(xlToLeft).Column
l1Row = Wb1.Worksheets(Sheetname).Cells(Rows.Count, 1).End(xlUp).Row
l2Col = Wb2.Worksheets(Sheetname).Cells(1, Columns.Count).End(xlToLeft).Column
l2Row = Wb2.Worksheets(Sheetname).Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To l1Col
For j = 1 To l2Col
If " " & Wb1.Worksheets(Sheetname).Cells(1, i).Value = Wb2.Worksheets(Sheetname).Cells(1, j).Value Then
'''If header matches in both excels then copy column to destination excel'''
'This is working but entire column copied
Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Columns(i)
'' This dosent work
'Wb2.Worksheets(Sheetname).Range(Cells(2, j), Cells(l2Row, j)).Copy Destination:=Wb1.Worksheets(Sheetname).Range(Cells(2, i), Cells(l1Row, i))
End If
Next j
Next i
You must paste to a Cell/Range and since you are copying a whole column, you must paste it on the first row of the target column.
Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Cells(1, i)
Change:
Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Columns(i)
To:
Wb2.Worksheets(Sheetname).Range(Chr(j + 64) & "2:" & Chr(j + 64) & Wb2.Cells(Wb2.Rows.Count, "C").End(xlUp).Row).Copy Destination:=Wb1.Worksheets(Sheetname).Range(Chr(i + 64) & "2")

(Excel Vba) Simple Copy & Paste of ranges ,but with random values

I cannt understand, why my excel script does not work anymore..
I need to do simple copy Paste function,
First, I have 1 value (Mean) which is generated and it changes randomly after any action (Very important point!)
So , I need a kind of "simulation", means to copy the value and put it in another worksheet, after that the excel is refreshing automatically and I get a new mean-value..
This process should be repeated 1000 times. It means i will have 1000 different values at the end, because of random changes of my mean-value
I have a script, which works perfect for this purpose.
Dim i As Integer
Sheets("Worksheet2").Select
Cells(4, 23).Select
Selection.Copy
'
Sheets("Worksheet3").Select
For i = 1 To 1000
Cells(1 + i, 1).PasteSpecial Paste:=xlPasteValues
Next i
'
End Sub
Now,
I have not only one cell (my mean-value) but two! ( median from the same data)
It means, now it should copy two cells simultaneously (range) and paste than in the new worksheet, in the new range.
So, it is the same process, like in my script, but with two cells
a kind of this..
Dim i As Integer
Sheets("Fracht Modell Roh").Select
Range("W4:X4").Select
Selection.Copy
'
Sheets("Ergebnisse").Select
For i = 1 To 100
Range("A2:B2" & 1 + i).PasteSpecial Paste:=xlPasteValues
Application.CalculateFull
Next i
'
End Sub
I tried to do it with range() BUT!!! it doesnt refresh my mean and median values anymore ... or something else... so I get 1000 times the SAME!! value after the script running.
I can not understand, what is his problem. Why in first case it works perfect, and if I do the same task with range, it seems to copy the same value about 1000 times, but not refreshing or changing it.
pleas, I hope, anybody could help me
thank you very much!
I think you meant to write this:
Dim i As Integer
Sheets("Fracht Modell Roh").Select
Range("W4:X4").Select
Selection.Copy
'
Sheets("Ergebnisse").Select
For i = 1 To 1000
Range("A" & i + 1 & ":B" & i + 1).PasteSpecial Paste:=xlPasteValues
Next i
However, your code doesn't need the Select statement to work, that will just let the code jump through sheets over and over without reasons. I might rather write it like this:
Dim i As Integer
Sheets("Fracht Modell Roh").Range("W4:X4").Copy
'
With Sheets("Ergebnisse")
For i = 1 To 1000
.Range("A" & i + 1 & ":B" & i + 1).PasteSpecial Paste:=xlPasteValues
Next i
End With
Same thing for your other code snippet, the one for a single random value:
Dim i As Integer
Sheets("Worksheet2").Cells(4, 23).Copy
'
With Sheets("Worksheet3")
For i = 1 To 1000
.Cells(1 + i, 1).PasteSpecial Paste:=xlPasteValues
Next i
End With
Moreover, if as I imagine the two cells in the first sheet contains two random functions =RAND(), why you don't directly write them in VBA?
With Sheets("Ergebnisse")
For i = 1 To 1000
.Range("A" & i + 1).Value = Rnd
.Range("B" & i + 1).Value = Rnd
Next i
End With

Trying to auto fill with VB for a really large spreadsheet >300,000 rows

In column A, I'm trying to duplicate the cell value in for the next 61 rows. Below is my attempt, but it doesn't seem to be working. I guess I'm not sure how to duplicate the cell values. Thanks for any suggestions, as I would like to automate this since the spreadsheet has over 300,000 rows.
Sub AnotherAttempt()
'
' AnotherAttempt Macro
'
' Keyboard Shortcut: Ctrl+r
'
iLoop = 2000
For i = 1 To iLoop
j = i - 1
Selection.AutoFill Destination:=Range("A4652 + 62*j:A4652 + 62*i - 1")
Next i
End Sub
Not clear for me what's the idea here, but for sure one thing is wrong... the way you're using j and i values. It should be like this:
Selection.AutoFill Destination:=Range("A" & 4652 + 62*j & ":A" & 4652 + 62*i - 1)
The maths should be done out of the string.

Resources