VBA Excel copy & paste multiple values repeatedly

1
votes

I have got an issue with multiple values in VBA excel, that I would like to copy and paste in another workbook (or also another worksheet, but not necessarily in this topic).

The point is, that I have got columns D and E with values ranged from row 1 to 366 (D1:D366 and E1:E366) and I have to switch them in cells A5 (column D) and B5 9column E). This is straightforward. However when I add up another commands to copy and paste values, whereas the range of copied cells remains constant and range of cells with paste data changes (increases 30 values every step) I don't know how to make this process quicker. I have made 5 repeatable combinations but I need still 361 another ones.

Is it some more convenient code for this operation?

My code is available here:

Sub jan01()
Range("A5") = ("=D1")
Range("B5") = ("=E1")
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A1:AP27").PasteSpecial xlPasteValues
End Sub

Sub jan02()
Range("A5") = ("=D2")
Range("B5") = ("=E2")
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A31:AP57").PasteSpecial xlPasteValues
End Sub

Sub jan03()
Range("A5") = ("=D3")
Range("B5") = ("=E3")
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A61:AP87").PasteSpecial xlPasteValues
End Sub

Sub jan04()
Range("A5") = ("=D4")
Range("B5") = ("=E4")
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A91:AP117").PasteSpecial xlPasteValues
End Sub

Sub jan05()
Range("A5") = ("=D5")
Range("B5") = ("=E5")
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A121:AP147").PasteSpecial xlPasteValues
End Sub

As per the description above the Values for cell A5 and B5 changes one by one. The range for sheet 13 increases every 30 cells down for each simple case. Ultimately I would like to have all copied data one by one without overlapping like in the image attached (zoomed out to show the general purpose). enter image description here To bring all together I used one macro:

Sub january()
Call jan01
Call jan02
Call jan03
Call jan04
Call jan05
End Sub

Anyway the job looks tedious and I believe, that is much quicker solution to solve it? Have someone had issue like this?

Thank you

3
excelvbacopypaste
So can these separate ones be combined? Or is there a reason to keep them separate? – QHarr
Hello Mariusz and welcome on Stack Overflow, I believe you could use a loop to perform such an operation, with something like a for loop in VBA, here is a tutorial. This can simplify your code and make it easier to read and operate. – Pierre Chevallier
And is Range("A5") in Sheets("11_POLAND") ? And what is Range("A5") = ("=D1") supposed to achieve? Is it simply Range("A5") = Range("D1") ? Or Range("A5").Formula = "=D1" ? Or something else entirely? – QHarr
These codes cannot be combined because each cell in rows D and E should be taken separately. I put ranges D and E where a particular values exist to calculate further values. – MKR

3 Answers

2
votes

I'm not 100% sure I am following what you are trying to achieve here, but I wrote this that seems to do the same as your existing code, but in one routine rather than six:

Sub january()
    Dim i As Integer
    i = 1
    While i < 6
        Range("A5") = ("=D" + CStr(i))
        Range("B5") = ("=E" + CStr(i))
        Sheets("11_POLAND").Range("AJ60:BY86").Copy
        Sheets("13").Range("A" + CStr(i + ((i - 1) * 30)) + ":AP" + CStr(i + ((i - 1) * 30) + 26)).PasteSpecial xlPasteValues
        i = i + 1
    Wend
End Sub

Using that as a starting point, I guess you could just change the i < 6 to i < 367?

1
votes

This is your code written using a For Loop. I still have my questions as posed above and assumptions re which sheet you are working with. This is similar to answer given except using variables to make reading code easier as well as use of Offset (again for ease of reading code).

Option Explicit
Public Sub CopyRanges()
    Application.ScreenUpdating = False
    Dim sheetFrom As Worksheet, sheetTo As Worksheet, i As Long
    Set sheetFrom = ThisWorkbook.Worksheets("11_POLAND")
    Set sheetTo = ThisWorkbook.Worksheets("13")
    Dim aRange As Range: Set aRange = sheetFrom.Range("A5")
    Dim bRange As Range: Set bRange = sheetFrom.Range("B5")

    With sheetFrom
        For i = 1 To 5 '<== 5 for up to jan05
            aRange = ("=D" & i)
            bRange = ("=E" & i)
            .Range("AJ60:BY86").Copy
            sheetTo.Range("A1:AP27").Offset((i - 1) * 30, 0).PasteSpecial xlPasteValues
        Next
    End With
    Application.ScreenUpdating = True
End Sub
0
votes

Thank you for help guys.

I have put a following code:

Sub january()
Dim i As Integer
For i = 1 To 31
Sheets("1_GENERAL").Range("A5") = ("=D" + CStr(i))
Sheets("1_GENERAL").Range("B5") = ("=E" + CStr(i))
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A" + CStr(i + ((i - 1) * 29)) + ":AP" + CStr(i + ((i - 1) * 29))).PasteSpecial xlPasteValues
Next i
End Sub

Where: - "i" states a particular row. In case of January this is from 1 to 31 (1-31 day of the year) - "29" means that every consequent top row is going to be pasted roughly 29 rows below. - Columns D and E includes the values bounded to certain "i" value.

I hope, that it will help for everyone struggling with big data in VBA Excel.