Copy to correct Worksheet, VBA

[mt]

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

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

 

[lozzablake]

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]

Mike
Not sure if this is what you wanted....

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]

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

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]

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]

Okay, I think I made those corrections, but still getting the same error regarding the "For Each Control".

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]

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

Dim Ce as Range

 

[mt]

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]

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?

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]

try

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