CODEWITHSUNDEEP
excelvba
Catarina Ribeiro
Catarina Ribeiro

Reputation: 646

How can I copy past+paste values from different cells from different worksheets to one?

I need your help.

I have a code that can copy values from different cells from a worksheet to another. I wanted to take that code and apply it to copy values from other files. However, I don't want to paste the values on the same column... and that's what happened. Can I change automatically the Range in each loop?


Sub Teste()

Dim NrCop As Integer 'this is the number of files I want

Set b = Workbooks.Open(Application.GetOpenFilename) 'the file that I want to past my values on
NrCop = InputBox("Quantos promotores são?")
Set a = Workbooks.Open(Application.GetOpenFilename) 'the files I want to copy the values from

For x = 1 To NrCop

    a.Activate
    Range("D4").Select 'this range is static
    Selection.Copy
    b.Activate
    Range("B3").Select ' for the next loop I want this range to change for C3
    Selection.PasteSpecial Paste:=xlPasteValues

    a.Activate
    Range("D5").Select
    Selection.Copy
    b.Activate
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues
     a.Activate
    Range("D11").Select
    Selection.Copy
    b.Activate
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues
     a.Activate
    Range("D37").Select
    Selection.Copy
    b.Activate
    Range("B6").Select
    Selection.PasteSpecial Paste:=xlPasteValues
     a.Activate
    Range("D48").Select
    Selection.Copy
    b.Activate
    Range("B7").Select
    Selection.PasteSpecial Paste:=xlPasteValues
     a.Activate
    Range("D74").Select
    Selection.Copy
    b.Activate
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues
     a.Activate
    Range("D100").Select
    Selection.Copy
    b.Activate
    Range("B9").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    a.Activate
    Range("D126").Select
    Selection.Copy
    b.Activate
    Range("B12").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    a.Activate
    Range("D152").Select
    Selection.Copy
    b.Activate
    Range("B13").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    a.Activate
    Range("D178").Select
    Selection.Copy
    b.Activate
    Range("B14").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    a.Activate
    Range("D204").Select
    Selection.Copy
    b.Activate
    Range("B15").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    a.Activate
    Range("D205").Select
    Selection.Copy
    b.Activate
    Range("B16").Select
    Selection.PasteSpecial Paste:=xlPasteValues
     a.Activate
    Range("D209").Select
    Selection.Copy
    b.Activate
    Range("B17").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    a.Activate
    Range("D212").Select
    Selection.Copy
    b.Activate
    Range("B18").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    a.Activate
    Range("D216").Select
    Selection.Copy
    b.Activate
    Range("B19").Select
    Selection.PasteSpecial Paste:=xlPasteValues

Next x

End Sub

Can you help me?

Upvotes: 0

Views: 56

Answers (1)

Dy.Lee
Dy.Lee

Reputation: 7567

Using arrays and variables simplifies code and speeds execution.

Sub test()
    Dim a As Workbook, b As Workbook
    Dim Ws As Worksheet, toWs As Worksheet
    Dim x As Integer, NrCop As Integer, n As Integer
    Dim i As Integer
    Dim vArray As Variant
    Dim vR() As Variant 'dynamic array

    Set b = Workbooks.Open(Application.GetOpenFilename) 'the file that I want to past my values on
    Set toWs = b.Sheets(1)

    NrCop = InputBox("Quantos promotores sao?")
    Set a = Workbooks.Open(Application.GetOpenFilename) 'the files I want to copy the values from
    Set Ws = a.Sheets(1)

    vArray = Array(4, 5, 11, 37, 48, 74, 100, 126, 152, 178, 204, 205, 209, 212, 216)
    n = UBound(vArray)
    ReDim vR(n)
    For i = 0 To n
        vR(i) = Ws.Range("d" & vArray(i))
    Next i

    For x = 1 To NrCop
        toWs.Range("b3").Offset(0, x - 1).Resize(n + 1) = WorksheetFunction.Transpose(vR)
    Next x

End Sub

Upvotes: 1

Related Questions