Copy to correct Worksheet, VBA

mt

Board Regular
Joined
Feb 24, 2006
Messages
134
In this code, I want to copy the appropriate "Template" based on the value in based on the value of Ce in the SouceSh. Each Source Sheet is named Data 1 thru 10, with i as the integer variable counter.

I want to copy 20 templates to each worksheet, so I was trying to find a way to count the number of rows for each Ce, so that if they exceed 20, the loop would go to the next Worksheet("Data i")

I would appreciate help with this code. Thanks
Mike

Code:
Sub LoadReleases()

Dim i As Integer
Set OutSh = Worksheets("Data" & i)
Set SourceSh = Worksheets("ReleaseLoads")
Set LastRow = Cells(65536, 1).End(xlUp).Row.Offset(1, 0)

For i = 1 To 10
With OutSh
For Each Ce In SourceSh.Range("A2:A" & LastRow)
If Ce.Row.Count > 20 Then
Next i

If Ce.Offset(0, 3).Value = "2SP" Then
Worksheets("Templates").Range("Temp2SP").Copy Destination:=OutSh.Range("A65536").End(xlUp).Offset(1, 0)
ElseIf Ce.Offset(0, 3).Value = "2S" Then
Worksheets("Templates").Range("Temp2S").Copy Destination:=OutSh.Range("A65536").End(xlUp).Offset(1, 0)
ElseIf Ce.Offset(0, 3).Value = "1SP" Then
Worksheets("Templates").Range("Temp1SP").Copy Destination:=OutSh.Range("A65536").End(xlUp).Offset(1, 0)
ElseIf Ce.Offset(0, 3).Value = "1S" Then
Worksheets("Templates").Range("Temp1S").Copy Destination:=OutSh.Range("A65536").End(xlUp).Offset(1, 0)
End If

Next Ce
Next i

End With

End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

lozzablake

Well-known Member
Joined
Dec 15, 2005
Messages
818
some clarification required

1) you do not define Ce anywhere. What is it?

The steps are as follows:

1) You are looping through the source sheet (ReleaseLoads) in some way and checking the value of Ce (this needs to be defined better as far as i can see you only have 1 instance of Ce so you would only copy one template at the moment)

2) based on the value of Ce you copy a template to a data sheet

3) Once you have copied 20 templates, start copying to the next data sheet

4) Do you need to check if there are more than 200 templates (20 copies on 10 data sheets) that require copying?

Please confirm that my understanding is correct and it should be easy to code
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Mike
Not sure if this is what you wanted....
Code:
Sub LoadReleases()

Dim i As Integer
Set SourceSh = Worksheets("ReleaseLoads")
Set LastRow = SourceSh.Cells(65536, 1).End(xlUp).Row.Offset(1, 0)

For i = 1 To 10
With Sheets("Data" & i)
For Each Ce In SourceSh.Range("A2:A" & LastRow)
If Ce.Row > 20 Then End

Select Case Ce.Offset(,3).Value
   Case "2SP","2S","1SP","1S"
      Worksheets("Templates").Range("Temp" & Ce.Offset(,3).Value).Copy Destination:=.Range("A65536").End(xlUp).Offset(1, 0)
End Select
Next Ce
End With
Next i
End Sub
 

mt

Board Regular
Joined
Feb 24, 2006
Messages
134
I appologize for not being clear and appreciate your effort to help me. I thinks this code more accurately depicts what I want to do after incorporating some of your strings, but I can not get past the Error,"For Each Control Variable must be Variant or Object."

I have similar code that works, so I can not figure this out, and obviously you know I am no expert.

Mike

Code:
Sub LoadReleasestest1()

Dim Ce As Integer
Set SourceSh = Worksheets("ReleaseLoads")

With OutSh
For Each Ce In SourceSh.Range("A2", SourceSh.Cells(Rows.Count), 1).End(xlUp)
    If Ce.Rows > 20 Then End
    If Ce.Rows > 2 And Ce.Rows < 22 Then OutSh = Worksheets("Data1")
    If Ce.Rows > 42 And Ce.Rows < 62 Then OutSh = Worksheets("Data2")
    If Ce.Rows > 62 And Ce.Rows < 82 Then OutSh = Worksheets("Data3")
    If Ce.Rows > 82 And Ce.Rows < 102 Then OutSh = Worksheets("Data4")
    If Ce.Rows > 102 And Ce.Rows < 122 Then OutSh = Worksheets("Data5")
    If Ce.Rows > 122 And Ce.Rows < 142 Then OutSh = Worksheets("Data6")
    If Ce.Rows > 142 And Ce.Rows < 162 Then OutSh = Worksheets("Data7")
    If Ce.Rows > 162 And Ce.Rows < 182 Then OutSh = Worksheets("Data8")
    If Ce.Rows > 182 And Ce.Rows < 202 Then OutSh = Worksheets("Data9")
    If Ce.Rows > 202 Then OutSh = Worksheets("Data10")
    End If
Select Case Ce.Offset(, 3).Value

   Case "2SP", "2S", "1SP", "1S"
      Worksheets("Templates").Range("Temp" & Ce.Offset(, 3).Value).Copy Destination:=OutSh.Range("A65536").End(xlUp).Offset(1, 0)
End Select
End With

Next Ce

Next i
End Sub
 

lozzablake

Well-known Member
Joined
Dec 15, 2005
Messages
818

ADVERTISEMENT

You do not have and End If

You have a next I with no For loop

Good practice is to have the matching start and end portions of these statements nested and matching in pairs

ie your End With should be after your Next Ce as the With statement is before the For Each statement.
 

mt

Board Regular
Joined
Feb 24, 2006
Messages
134
Okay, I think I made those corrections, but still getting the same error regarding the "For Each Control".

Code:
Sub LoadReleasestest1()

Dim Ce As Integer
Set SourceSh = Worksheets("ReleaseLoads")

With OutSh
For Each Ce In SourceSh.Range("A2", SourceSh.Cells(Rows.Count), 1).End(xlUp)
    If Ce.Rows > 20 Then End
    If Ce.Rows > 2 And Ce.Rows < 22 Then OutSh = Worksheets("Data1")
    If Ce.Rows > 42 And Ce.Rows < 62 Then OutSh = Worksheets("Data2")
    If Ce.Rows > 62 And Ce.Rows < 82 Then OutSh = Worksheets("Data3")
    If Ce.Rows > 82 And Ce.Rows < 102 Then OutSh = Worksheets("Data4")
    If Ce.Rows > 102 And Ce.Rows < 122 Then OutSh = Worksheets("Data5")
    If Ce.Rows > 122 And Ce.Rows < 142 Then OutSh = Worksheets("Data6")
    If Ce.Rows > 142 And Ce.Rows < 162 Then OutSh = Worksheets("Data7")
    If Ce.Rows > 162 And Ce.Rows < 182 Then OutSh = Worksheets("Data8")
    If Ce.Rows > 182 And Ce.Rows < 202 Then OutSh = Worksheets("Data9")
    If Ce.Rows > 202 Then OutSh = Worksheets("Data10")
    End If
Select Case Ce.Offset(, 3).Value

   Case "2SP", "2S", "1SP", "1S"
      Worksheets("Templates").Range("Temp" & Ce.Offset(, 3).Value).Copy Destination:=OutSh.Range("A65536").End(xlUp).Offset(1, 0)
End Select


Next Ce
End With

End Sub
 

lozzablake

Well-known Member
Joined
Dec 15, 2005
Messages
818

ADVERTISEMENT

Ce cannot be an integer. I think it should be a range

Dim Ce as Range
 

mt

Board Regular
Joined
Feb 24, 2006
Messages
134
Okay, it looks like the Ce control is solved. But, now my OutSh definition does not seem to work. When substitute, OutSh for "Data1" in the Copy Destination, it works. Is there a better way to direct which worksheet to copy to based on the Ce control?

Thanks for your patience.
Mike
 

mt

Board Regular
Joined
Feb 24, 2006
Messages
134
I tried a different approach here, but having trouble with the If Statements, getting error, "End if without block if". But, I can not figure out what "If" is missing. Any ideas what I can do to fix this?

Code:
Sub LoadReleasestest3()

Dim Ce As Range
Dim OutSh As Worksheet
Set SourceSh = Worksheets("ReleaseLoads")

For Each Ce In Worksheets("ReleaseLoads").Range(A2, SourceSh.Cells(Rows.Count), 1).End(xlUp)
    
    If Ce.Rows > 2 And Ce.Rows < 22 Then Select Case Ce.Offset(, 3).Value
    Case "2SP", "2S", "1SP", "1S"
    Worksheets("Templates").Range("Temp" & Ce.Offset(, 3).Value).Copy Destination:=Worksheets("Data1").Range("A65536").End(xlUp).Offset(1, 0)
    End Select
    
    ElseIf Ce.Rows > 22 And Ce.Rows < 42 Then Select Case Ce.Offset(, 3).Value
    Case "2SP", "2S", "1SP", "1S"
    Worksheets("Templates").Range("Temp" & Ce.Offset(, 3).Value).Copy Destination:=Worksheets("Data2").Range("A65536").End(xlUp).Offset(1, 0)
    End Select
ElseIf Ce.Rows > 182 And Ce.Rows < 202 Then Select Case Ce.Offset(, 3).Value
    Case "2SP", "2S", "1SP", "1S"
    Worksheets("Templates").Range("Temp" & Ce.Offset(, 3).Value).Copy Destination:=Worksheets("Data10").Range("A65536").End(xlUp).Offset(1, 0)
    End Select
    End If

Next Ce


End Sub
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
try
Code:
Sub LoadReleasestest3()

Dim Ce As Range
Dim OutSh As Worksheet
Dim e As Variant
Set SourceSh = Worksheets("ReleaseLoads")

For Each e In Array(3,23,183)
   For Each Ce In SourceSh.Range("A" & e & ":A" & e + 18)
      Select Case Ce.Offset(,3).Value
         Case "2SP", "2S", "1SP", "1S"
            Worksheets("Templates").Range("Temp" & Ce.Offset(, 3).Value).Copy _
            Destination:=Worksheets("Data1").Range("A65536").End(xlUp).Offset(1, 0)
      End Select
   Next Ce
Next

End Sub
 

Forum statistics

Threads
1,136,272
Messages
5,674,753
Members
419,525
Latest member
helensesc

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top