Copy Dynamic Range problem

  • Thread starter Thread starter Len
  • Start date Start date
L

Len

Hi

I am copying a dynamic range of cells from 12 different worksheets
under workbook A.
I need to select an adjacent range that starts with "OP" ( always at
column A ) on every sheet ( 12 ) and copy
that adjacent range of data without the formula to another workbook B
in each of 12 worksheets
at the next 5 rows of last used cells of column E
E.g. if there is "OP" in the mid of column A, select the current
region starts from column B to O
in sheet "ADP" ( out of 12 sheets ) under workbook A and copy (without
the formula ) paste to sheet"ADP" ( out of 12 sheets ) under workbook
B
at the next 5 rows of last used cells of column E

Below is the extract of draft excel vba code for a single sheet seems
to be incomplete as it copies row by row and does not work as
intended, further I have no idea how to design excel vba for multiple
sheets

Dim wsNew As Worksheet
Dim OpWs As Worksheet
Dim sTarget As String
Dim i As Integer

Sheets.Add Before:=Sheets(1)
Set OpWs = ActiveSheet

Workbooks.Open Filename:="C:\Budget Final\Acad\ADP.xls"
Windows("ADP.xls").Activate
Set wsNew = Sheets("P+L")
sTarget = "OP"
With Worksheets("P+L")
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For i = 1 To iLastRow
If .Cells(i, "A").Value = sTarget Then
iNextRow = iNextRow + 1

.Rows(i).Copy OpWs.Cells(iNextRow, "A")
End If
Next i
End With

Appreciate any help to solve the above problem as I'm excel vba
beginner

Many thanks

Warm regards
Len
 
See if this works.  Not sure if you have more than one workbook.  I'm
opening a second workbook and putting the data in a new sheet in the
workbook where the macro is located..

Sub getdata()

fileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")
If fileToOpen = False Then
MsgBox ("Cannot open file - Exiting Macro")
Exit Sub
End If

Set bk = Workbooks.Open(Filename:=fileToOpen)

With ThisWorkbook
Set NewSht = .Sheets.Add(before:=.Sheets(1))
NewSht.Name = "Summary"

For Each Sht In bk.Sheets
If Sht.Name <> "Summary" Then
With Sht
Set c = .Columns("A").Find(what:="OP", _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("Could not find OP in sheet : " & Sht.Name)
Else
LastRow = .Range("E" & Rows.Count).End(xlUp).Row
FirstRow = LastRow - 4

If LastRow <= c.Row Then
MsgBox ("There are no rows to copy on sheet : " &
Sht.Name)
Else

If FirstRow <= c.Row Then
FirstRow = c.Row + 1
End If

Set Copyrange = .Range("B" & FirstRow & ":O" &
LastRow)

With NewSht
LastRow = .Range("E" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
Copyrange.Copy
.Range("B" & LastRow).PasteSpecial _
Paste:=xlPasteValues
End With
End If
End If
End With
End If
Next Sht
End With

bk.Close savechznges:=False
End Sub

--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:http://www.thecodecage.com/forumz/showthread.php?t=168586

Microsoft Office Help
Click to expand...

Hi Joel,

Thanks for your prompt reply
After I run your codes and the result copies the wrong range
Your codes copy the adjacent range at the last used rows ( ie wrong
range ), instead it should copy the row starting below immediately
after the row which found "OP" in cloumn A until the last used rows
from column B to column O
The correct range to copy should cover the current region starting row
"OP" until the last used row from column B to column O

I try to fix your codes but it does not work

Regards
Len
 
You posting wasn't clear and most people want it the way I did it.  I
also understand why you want it the other way.  sorry!

Try these changes

From

LastRow = .Range("E" & Rows.Count).End(xlUp).Row
FirstRow = LastRow - 4

If LastRow <= c.Row Then
MsgBox ("There are no rows to copy on sheet : " & Sht.Name)
Else

If FirstRow <= c.Row Then
FirstRow = c.Row + 1
End If

To

EndRow = .Range("E" & Rows.Count).End(xlUp).Row

If EndRow <= c.Row Then
MsgBox ("There are no rows to copy on sheet : " & Sht.Name)
Else
FirstRow = c.row + 1
LastRow = FirstRow + 4

If LastRow > EndRow Then
LastRow = Endrow
End If

--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:http://www.thecodecage.com/forumz/showthread.php?t=168586

Microsoft Office Help
Click to expand...

Hi Joel,

Sorry........... my earlier post not clear and now your modified codes
works perfectly

Thanks alot

Regards
Len
 
Back
Top