Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Dynamic Range problem
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 Befo=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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Dynamic Range problem
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(befo=.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/sh...d.php?t=168586 Microsoft Office Help |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Dynamic Range problem
On Jan 10, 8:33*pm, joel wrote:
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(befo=.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/sh...d.php?t=168586 Microsoft Office Help 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Dynamic Range problem
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/sh...d.php?t=168586 Microsoft Office Help |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Dynamic Range problem
On Jan 10, 10:53*pm, joel wrote:
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/sh...d.php?t=168586 Microsoft Office Help Hi Joel, Sorry........... my earlier post not clear and now your modified codes works perfectly Thanks alot Regards Len |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Dynamic copy range | Excel Programming | |||
dynamic charts - problem with copy | Charts and Charting in Excel | |||
Copy dynamic range | Excel Programming | |||
Dynamic range copy. | Excel Programming | |||
Dynamic range problem #2 | Excel Programming |