VBA: Looping to copy and paste information between two sheets

[canyon]

Hello everyone,

I have two excel Workbooks (WB1 & WB2), WB1 one has an input tab (G2) where I paste the values from WB2 (Range: B2:B78) to get an output (G3) which I want to have pasted back into WB2 ( in Column D2:D78). I have about 78 rows to go through and thought this could be a good application to try out looping however, I can't seem to get it to loop through all the rows.

Sub loopthru()

Dim rng As Range, cell As Range

Set rng = Range("B2:B78")



For Each cell In rng

Range("B2").Select
Selection.Copy
Windows("WB1.xlsx").Activate
Range("G2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
Range("G3").Select
Windows("wb2.xlsx").Activate
Range("D2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

Next cell


End Sub

 

[mohadin]

Range("B2").Select
Selection.Copy

Can be

Range("B2:B78").Selection.Copy

No need for

For Each cell In rng

 

[canyon]

Range("B2").Select
Selection.Copy

Can be

Range("B2:B78").Selection.Copy

No need for

For Each cell In rng

Hi there,

unfortunately that doesn't work as it just copies and pastes the range from B2:B78.

I need the value in B2 from Workbook 2 to be copied and pasted into cell G2 in Workbook 1.

There is a formula in G3 which provides an output in cell G3 and paste it into D2 in WB2.

Rinse and repeat until B78 has an accompanying value in D78.

 

[mohadin]

Try

Sub loopthru()

    Dim rng As Range, cell As Range
    Set rng = Range("B2:B78")
    For Each Mycell In rng
        Mycell.Copy
        Windows("WB1.xlsx").Activate
        Range("G2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                                 xlNone, SkipBlanks:=False, Transpose:=False
        Range("G3").Select
        Windows("wb2.xlsx").Activate
        Range("D2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                                 xlNone, SkipBlanks:=False, Transpose:=False

    Next
End Sub