Got it
c.Resize(1, 20).Offset(, -3).Copy sh.Cells(i, "a")
i = i + 1
"Sjakkie" wrote:
> worked an absolute treat. Thanks.
>
> One last question. with the code below,
>
> If InStr(1, c.Value, "") Then
> s = Trim(Left(c, Len(c) - 5))
> iloc = InStr(1, s, "/", vbTextCompare)
> If iloc <> 0 Then
> s = Trim(Left(s, iloc - 2))
> End If
>
> Set sh = Nothing
> On Error Resume Next
> Set sh = Sheets(s)
> On Error GoTo 0
>
> 'now check to see if that sheet didn't exist
> If sh Is Nothing Then
> 'it doesn't exist, so add it
> Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> sh.Name = s
> Else
> c.Resize(1, 15).Copy sh.Cells(i, "D")
> i = i + 1
>
> Which is from the code earlier in the script.
> I have another Data dump which i have an option in row d. however with the
> above code i end up with only the data ranging from D Till the 15th column
> after that. Is there a was where i can tell it to also take the column A, B
> and C with this.....
>
>
>
> "Dave Peterson" wrote:
>
> > Since you're adding sheets and renaming them immediately, you could just check
> > to see if that worksheet name already exists. If it does, just skip it.
> >
> > This portion:
> > Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> > sh.Name = s
> >
> > Becomes:
> > set sh = nothing
> > on error resume next
> > set sh = sheets(s)
> > on error goto 0
> >
> > 'now check to see if that sheet didn't exist
> > if sh is nothing then
> > 'it doesn't exist, so add it
> > Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> > sh.Name = s
> > end if
> >
> >
> >
> >
> > Sjakkie wrote:
> > >
> > > How do i change the script below to go through the list and have the
> > > duplicates searched aswell but only
> > > allow the name to be used once.
> > >
> > > so that if there is
> > >
> > > lead 1
> > > lead 2
> > > lead 3
> > > lead 4
> > > lead 4
> > > lead 5
> > > lead 6
> > > lead 4
> > >
> > > That it just makes the Worksheets
> > > lead 1
> > > lead 2
> > > lead 3
> > > lead 4
> > > lead 5
> > > lead 6
> > >
> > > Sub SplitDump()
> > >
> > > Dim sh As Worksheet, s As String
> > > Dim i As Long, iloc as Long
> > > Dim c As Range
> > > Dim strAddress As String
> > > Dim test As Integer
> > >
> > > strMain = ActiveSheet.Name
> > > i = 2
> > > For Each c In Range("a1:a60")
> > > strAddress = c.Address
> > > If Len(c.Value) = 0 Then
> > > MsgBox ("Finished")
> > > Exit Sub
> > > End If
> > >
> > > If InStr(1, c.Value, "Lead:") Then
> > > s = Trim(Right(c, Len(c) - 5))
> > > iloc = Instr(1,s,"/",vbTextcompare)
> > > if iloc <> 0 then
> > > s = Trim(Left(s,iloc-1))
> > > end if
> > > Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> > > sh.Name = s
> > > i = 2
> > > Else
> > > c.Resize(1, 5).Copy sh.Cells(i, "A")
> > > i = i + 1
> > > End If
> > > Next c
> > >
> > > End Sub
> >
> > --
> >
> > Dave Peterson
> >
|