Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to extract data and paste to a new sheet
Could anyone please help
I have what you would call a 'typical' spreadsheet i.e. categories across row 1, dates down column A then a value against certain categories on certain dates. What I'm trying to do is create a macro that extracts the data, the date and and the category to a new work sheet but only where data actually exists. I'm essentially trying to create a data table from the existing worksheet. Regards Les. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to extract data and paste to a new sheet
Hi Les,
Try something like: '================ Public Sub CopyTable() Dim WB As Workbook Dim SH As Worksheet Dim destsh As Worksheet Dim rng As Range Dim rCell As Range Dim copyRng As Range Dim destrng As Range Dim CalcMode As Long Dim ViewMode As Long Set WB = ActiveWorkbook '<<===== CHANGE Set SH = WB.Sheets("Sheet1") '<<===== CHANGE Set destsh = WB.Sheets("Sheet2") '<<===== CHANGE Set destrng = destsh.Range("A1") '<<===== CHANGE Set rng = SH.Range("A1", Cells(Rows.Count, "A").End(xlUp)) On Error GoTo XIT With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With With ActiveWindow ViewMode = .View .View = xlNormalView End With SH.DisplayPageBreaks = False For Each rCell In rng.Cells If Application.CountA(rCell.EntireRow) 1 Then If copyRng Is Nothing Then Set copyRng = rCell Else Set copyRng = Union(rCell, copyRng) End If End If Next rCell If Not copyRng Is Nothing Then copyRng.EntireRow.Copy Destination:=destrng Else 'nothing found, do nothing End If XIT: With Application .Calculation = CalcMode .ScreenUpdating = True End With ActiveWindow.View = ViewMode End Sub '<<================ --- Regards, Norman "Les" wrote in message ... Could anyone please help I have what you would call a 'typical' spreadsheet i.e. categories across row 1, dates down column A then a value against certain categories on certain dates. What I'm trying to do is create a macro that extracts the data, the date and and the category to a new work sheet but only where data actually exists. I'm essentially trying to create a data table from the existing worksheet. Regards Les. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to extract data and paste to a new sheet
Hi Norman
Thanks for the help and the very quick response. I know my way around Excel but I'm afraid I'm still getting used to VB. Could you tell me what is being said in the 'Set' lines of code where you are saying 'change'. Thanks Les. "Norman Jones" wrote: Hi Les, Try something like: '================ Public Sub CopyTable() Dim WB As Workbook Dim SH As Worksheet Dim destsh As Worksheet Dim rng As Range Dim rCell As Range Dim copyRng As Range Dim destrng As Range Dim CalcMode As Long Dim ViewMode As Long Set WB = ActiveWorkbook '<<===== CHANGE Set SH = WB.Sheets("Sheet1") '<<===== CHANGE Set destsh = WB.Sheets("Sheet2") '<<===== CHANGE Set destrng = destsh.Range("A1") '<<===== CHANGE Set rng = SH.Range("A1", Cells(Rows.Count, "A").End(xlUp)) On Error GoTo XIT With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With With ActiveWindow ViewMode = .View .View = xlNormalView End With SH.DisplayPageBreaks = False For Each rCell In rng.Cells If Application.CountA(rCell.EntireRow) 1 Then If copyRng Is Nothing Then Set copyRng = rCell Else Set copyRng = Union(rCell, copyRng) End If End If Next rCell If Not copyRng Is Nothing Then copyRng.EntireRow.Copy Destination:=destrng Else 'nothing found, do nothing End If XIT: With Application .Calculation = CalcMode .ScreenUpdating = True End With ActiveWindow.View = ViewMode End Sub '<<================ --- Regards, Norman "Les" wrote in message ... Could anyone please help I have what you would call a 'typical' spreadsheet i.e. categories across row 1, dates down column A then a value against certain categories on certain dates. What I'm trying to do is create a macro that extracts the data, the date and and the category to a new work sheet but only where data actually exists. I'm essentially trying to create a data table from the existing worksheet. Regards Les. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to extract data and paste to a new sheet
Hi Les,
I know my way around Excel but I'm afraid I'm still getting used to VB. Could you tell me what is being said in the 'Set' lines of code where you are saying 'change'. Set WB = ActiveWorkbook '<<===== CHANGE If the code is to operate on the active workbook, no change is required. If the code is to operate on the workbook holding the code, change this line to: Set WB = ThisWorkbook If, the code is to operate on another workbook, you will need to provide the name, e.g.: Set WB = Workbooks("Les.xls") where Les.xls is the name of the workbook of interest. Set destsh = WB.Sheets("Sheet2") '<<===== CHANGE Replace Sheet2 with the name of the sheet which is to receive the copied data. Set destrng = destsh.Range("A1") '<<===== CHANGE ReplaceA1 with the address of the first cell of the destination range for the copied data. --- Regards, Norman "Les" wrote in message ... Hi Norman Thanks for the help and the very quick response. I know my way around Excel but I'm afraid I'm still getting used to VB. Could you tell me what is being said in the 'Set' lines of code where you are saying 'change'. Thanks Les. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
1 Create a macro to Copy & paste certain data to another sheet | Excel Discussion (Misc queries) | |||
macro to extract data of a selected sheet | Excel Discussion (Misc queries) | |||
Open Sheet, Run Macro, Extract data | Excel Programming | |||
Macro 2 Extract Data 2 Paste in New Wksht | Excel Programming | |||
macro to extract info and paste to a new sheet | Excel Programming |