VBA code problems dealing with the order of copy

[castklefamilies]

Hello,

Any help would be appreciated as I am still new and learning VBA. I was able to put this code together to allow me to mark an x on one sheet and it copy Columns A, B, D, F to another sheet. I actually need them to copy in the order A,B,F,D instead. I thought it would be as simply as changing the order in the range of the code but that is not working. 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 greatly appreciated.

Dustin

 

[JLGWhiz]

Add this to your declarations:

Dim ary As Variant, i As Long

Then modifiy this:

t = t + 1
s = rng.Row
wshS.Range("A" & s & ",B" & s & ",D" & s & ",F" & s).Copy _
Destination:=wshT.Range("B" & t)

To this

ary = Array("A", "B", "F", "D")
    For i = LBound(ary) To UBound(ary)
        t= t + 1
        wshS.Range(ary(i) & s).Copy wshT.Range("B" & t)
    Next

 

[castklefamilies]

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
Dim ary As Variant
Dim i 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
ary = Array("A", "B", "F", "D")
For i = LBound(ary) To UBound(ary)
t = t + 1
wshS.Range(ary(i) & s).Copy wshT.Range("B" & t)
Next
' 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

I added them, but now I get a run-time erros 1004 Method 'Range' of object'_Worksheet' failed. The Highlighted part in debugger is wshS.Range(ary(i) & s).Copy wshT.Range("B" & t)

 

[JLGWhiz]

the rng.Row variable was missing. This should cure it.

Sub TransferJLG()
Dim wshS As Worksheet, wshT As Worksheet, rng As Range, strAddress As String
Dim t As Long, ary As Variant, i 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
                            ary = Array("A", "B", "F", "D")
                            For i = LBound(ary) To UBound(ary)
                                t = t + 1
                                wshS.Range(ary(i) & rng.Row).Copy wshT.Range("B" & t)
                            Next
                            ' Optional: clear the "X"
                            wshS.Range("J" & rng.Row).ClearContents
                            Set rng = wshS.Range("J:J").FindNext(After:=rng)
                            If rng Is Nothing Then Exit Do
                        Loop While rng.Address <> strAddress
                    End If
            End If
        Next wshS
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[castklefamilies]

Thank you, it's works brilliantly. I cannot thank you enough. I do have a question if something is possible. Right now when I run the Macro on the sheets it pulls them into order by date, not by where I place the X. I work with rail cars and I need it to pull them in the order I mark them in, not by the dates on the sheets. Is that possible? Do you need to see the workbook to do so?

 

[JLGWhiz]

You are wecome. Regarding the quesion of sequencing the copied ranges. There is not enough explanation of the sheet's data nor its layout to provide any code that would sequence the data by the order in which you place the 'X' on each sheet. X is X and that is all Excel sees, so there would have to be a means of determining what order you place the 'X' in column J. In simple terms, the criteria you use to make the selections of where the X goes. If that information is located in the data contained in the sheets, then it can be used to sort the items marked with the 'X'. But according to Forum guidelines, that should be pursued by opening a new thread. You can also get information on how to attach images by clicking the highlighted word "Attachments" in my signature blurb below. Or use one of several free share servers to upload your file and then post the link in your thread.

Regards, JLG

 

[Fluff]

Cross posted http://www.vbaexpress.com/forum/showthread.php?65880-Change-the-copy-order-in-this-VBA-code

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.