PDA

View Full Version : Change the copy order in this VBA code



castlefamily
09-12-2019, 09:34 AM
Hello all,

I wrote this code with a lot of headaches and help, but I am at a problem. I was not aware that I would need the columns to copy to the new sheet in a specific order. Right now the code allows me to put an x on any sheet and that copies columns A,B,D,F of the row marked. I need the order to be A,B,F,D. I have tried changing the order in the range, as well as setting cells equal, but I am in over my head. Here is the code:


Sub Transfer()
Dim wshS As Worksheet
Dim wshT As Worksheet
Dim rng As Range
Dim strAddress As String
Dim s As Long
Dim t As Long
Application.ScreenUpdating = False
Set wshT = Worksheets("Inspection")
t = wshT.Range("B" & wshT.Rows.Count).End(xlUp).Row
If t < 4 Then t = 4
For Each wshS In Worksheets
If wshS.Name <> wshT.Name Then
Set rng = wshS.Range("J:J").Find(What:="X", LookAt:=xlWhole)
If Not rng Is Nothing Then
strAddress = rng.Address
Do
t = t + 1
s = rng.Row
wshS.Range("A" & s & ",B" & s & ",D" & s & ",F" & s).Copy _
Destination:=wshT.Range("B" & t)
' Optional: clear the "X"
wshS.Range("J" & s).ClearContents
Set rng = wshS.Range("J:J").FindNext(After:=rng)
If rng Is Nothing Then Exit Do
Loop Until rng.Address = strAddress
End If
End If
Next wshS
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Any help would be appreciated

Artik
09-12-2019, 01:16 PM
rather than
wshS.Range("A" & s & ",B" & s & ",D" & s & ",F" & s).Copy _
Destination:=wshT.Range("B" & t)


use
wshS.Range("A" & s & ":B" & s).Copy _
Destination:=wshT.Range("B" & t)
wshS.Range("F" & s).Copy _
Destination:=wshT.Range("D" & t)
wshS.Range("D" & s).Copy _
Destination:=wshT.Range("E" & t)



Artik

castlefamily
09-13-2019, 09:06 AM
Worked perfectly. Thank you

SamT
09-13-2019, 08:00 PM
With wshS.Rows(s)
.Range("A:B").Copy wshT.Range("B" & t)
.Range("F").Copy Etc
Etc
End With

mana
09-14-2019, 03:13 AM
If common headers exist in all worksheets



Sub test()
Dim wshS As Worksheet
Dim wshT As Worksheet
Dim rngS As Range, rngD As Range, rngC As Range

Set wshT = Worksheets("Inspection")
Set rngD = wshT.Cells(1, wshT.UsedRange.Columns.Count + 2)
wshT.[b3].Resize(, 4).Copy rngD
Set rngD = rngD.CurrentRegion

For Each wshS In Worksheets
If wshS.Name <> wshT.Name Then
Set rngS = wshS.[a1].CurrentRegion
Set rngC = rngS.Offset(, rngS.Columns.Count + 1).Resize(2, 1)
rngC(2).Formula = "=J2=""X"""

rngS.AdvancedFilter xlFilterCopy, rngC, rngD
rngD.CurrentRegion.Offset(1).Copy
wshT.Cells(Rows.Count, 2).End(xlUp).Offset(1).PasteSpecial xlValues
rngC.Clear
rngS.Columns("j").Offset(1).ClearContents
End If
Next

rngD.CurrentRegion.Clear

End Sub

Tom Jones
09-14-2019, 10:37 PM
Cross posting.
You get lots of answer here:

VBA code problems dealing with the order of copy (https://www.mrexcel.com/forum/excel-questions/1109641-vba-code-problems-dealing-order-copy.html)