Copy adjacent cells and paste in non adjacent columns

[jolivanes]

Bob (xld) kindly supplied me with code to make a summary sheet where
two cells are copied from a multiple amount of sheets and pasted in
the summary sheet. These cells are adjacent. All this works great.
See http://www.vbaexpress.com/forum/showthread.php?t=26090 (http://www.vbaexpress.com/forum/showthread.php?t=26090)
After all is done, I cut the cells in Column B and paste them in Column D.
The code I got from Bob is as follows:



For shNum = 4 To Worksheets.Count

Set sh = Worksheets(shNum)
If sh.Name <> destSH.Name Then
sh.Range("B3:C3").Copy
With destSH.Cells(rw, 1)
.PasteSpecial Paste:=xlPasteValues
End With

rw = rw + 1
End If
Next shNum


I added the following below it to move column B values to column D:



Range("B10:B" & Cells(Rows.Count, "B").End(xlUp).Row).Cut Destination:=Range("D10")


Would there be an efficient way, without losing speed, to incorporate
that in the macro from Bob?

Thanks and Regards
John

[MikeBlackman]

Hi,

Do you need the formula in Col B or just the values? Maybe;


Dim lRow As Long

lRow = Range("B" & Rows.count).End(xlUp).Row

With Range("B10:B" & lRow)
Range("D10:D" & lRow) = .Value
.Value = ""
End With

[jolivanes]

Good Morning (afternoon) Mike.
Sorry for the confusion.
What I meant is when Bob's solution takes the info from
one sheet and copies it to the summary sheet, instead of pasting it in adjacent cells in the summary sheet, paste it in offsetting columns.
I would like, if it is possible, have the string copied from column B pasted
in column A in the summary sheet and the values copied from column C
pasted in column D.
For instance, the first time it copies the two adjacent cells, it pastes them in column A so the string will be in column A and the value will be in column B. I would like the value to be in column D.
I hope I expressed myself clearly.
Thank you for helping Mike

Regards
John

[MikeBlackman]

Hi,

Maybe this instead?


For i = 4 To Worksheets.count
With Sheets(i)
If .Name <> destSH.Name Then ' destSH.Name has not yet been defined???
destSH.Cells(i - 3, 1).Resize(1, 2) = .Range("B3:C3")
.Range("D3") = .Range("C3")
End If
End With
Next i

[jolivanes]

Hi Mike
I have to work with it a little later when I have some more time. I just quickly tried it and it did not copy anything at all. More then likely that I did not insert it proper in the whole macro.
Will let you know Mike.
Thanks and regards
John

[jolivanes]

Hi Mike
I tried changing some of the code you supplied but nothing I do makes it work.
Thanks for the help Mike.
Regards.
John

[mdmackillop]

Something like

Option Explicit
Sub SwapColumns()
Dim destSH As Worksheet, sh As Worksheet
Dim Rw As Long, shNum As Long
Rw = 2
Set destSH = ActiveSheet
For shNum = 4 To Worksheets.Count
Set sh = Worksheets(shNum)
With destSH
.Cells(Rw, 2).Value = sh.Range("C3").Value
.Cells(Rw, 3).Value = sh.Range("B3").Value
End With
Rw = Rw + 1
Next shNum
End Sub

[jolivanes]

mdmackillop.
Yes, that's it. Thanks a million.
One thing baffles me though. I tried your code on a workbook with 35 sheets and it will put the first amount from cell D10 also in cell D45 but
not the relevant string in cell A45. What I am trying to say is that I get
one extra entry in column D at the end that should not be there.

The code is now as follows:



Sub SwapColumns()
Dim destSH As Worksheet, sh As Worksheet
Dim Rw As Long, shNum As Long
Application.ScreenUpdating = False

Sheets("Daily").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = "Summary"
.Shapes("SaveDailyButton").Delete
.Range("A10:D" & Cells(Rows.Count, "D").End(xlUp).Row).ClearContents
End With

Rw = 10
Set destSH = Worksheets("Summary") 'ActiveSheet
For shNum = 4 To Worksheets.Count
Set sh = Worksheets(shNum)
With destSH
.Cells(Rw, 1).Value = sh.Range("C10").Value
.Cells(Rw, 4).Value = sh.Range("D10").Value
End With
Rw = Rw + 1
Next shNum

With Sheets("Summary").Range("A10:D" & Cells(Rows.Count, "D").End(xlUp).Row).Font
.Name = "Verdana"
.Size = 9
.Bold = False
.Italic = False
End With

With Sheets("Summary").Range("D10:D" & Cells(Rows.Count, "D").End(xlUp).Row)
.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
End With
Application.ScreenUpdating = True

End Sub


I can't find why it would be doing that.

[mdmackillop]

Because you are adding Summary as the last sheet
Try

For shNum = 4 To Worksheets.Count - 1

[jolivanes]

mdmackillop.

Yes, absolutely right.

Thank you so much again.

A Happy Easter to you and yours.

Regards.

John