Restricting macro run to few columns
- Thread starter Dee
- Start date
Dee,
The easiest way would be to limit the data that you are copying and then pasting the limited data into the sheet. Some code elements that might help with the copy:
To select the region around the active cell (cells with data in them):
ActiveCell.CurrentRegion.Select
To select all active cells below a cell (same as shift+end+down):
Range(Selection, Selection.End(xlDown)).Select
To select all active cells to right of a cell (same as shift+end+right):
Range(Selection, Selection.End(xlToRight)).Select
Myles
The easiest way would be to limit the data that you are copying and then pasting the limited data into the sheet. Some code elements that might help with the copy:
To select the region around the active cell (cells with data in them):
ActiveCell.CurrentRegion.Select
To select all active cells below a cell (same as shift+end+down):
Range(Selection, Selection.End(xlDown)).Select
To select all active cells to right of a cell (same as shift+end+right):
Range(Selection, Selection.End(xlToRight)).Select
Myles
Dee... this also depends on the structure of your data. For eg. if you data source data has more columns than up to DI, then you need to stop importing those columns thru macro code.
Here is a rough algorithm for your need. You can easily morph this in to VBA...
for each row in source data
for each column in that row
if the column number is less than 'DI'
replace target sheet row 'i' column 'j'
j++
end if
next column
i++
next row
remove data in all the balance rows after i until end of sheet
Here is a rough algorithm for your need. You can easily morph this in to VBA...
for each row in source data
for each column in that row
if the column number is less than 'DI'
replace target sheet row 'i' column 'j'
j++
end if
next column
i++
next row
remove data in all the balance rows after i until end of sheet
Hey Chandoo, thanks for the help.
In both the cases (source data & In-work file) the data is there till DI. In In-work file i have lot of formula which pulls data from some other file from share point site.Whenever i run macro it is removing the data in the cells beyond DI.
Thanks,
Dee
In both the cases (source data & In-work file) the data is there till DI. In In-work file i have lot of formula which pulls data from some other file from share point site.Whenever i run macro it is removing the data in the cells beyond DI.
Thanks,
Dee
Here is the codes...
Dim Ftwbook As Workbook
Dim Thiswbook As Workbook
Dim LastPM, LastCell, RIndex, counter As Integer
Dim Wksheet As Worksheet
Dim Flatfilename As String
Dim Filewithmacro As String
Application.ScreenUpdating = False
Flatfilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls", Title:="Please choose a file")
Filewithmacro = ThisWorkbook.Name
Set Ftwbook = Workbooks.Open(Filename:=Flatfilename, ReadOnly:=yes)
Set Thiswbook = Workbooks(Filewithmacro)
ThisWorkbook.Worksheets("Project Managers").Activate
Range("A1").Select
LastCell = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
ReDim PM(LastCell) As String
For counter = 0 To LastCell - 1
PM(counter) = ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Next counter
Thiswbook.Worksheets("Project List").Activate
Range("A4", Range("A4").SpecialCells(xlCellTypeLastCell).Address).Rows.ClearContents
Ftwbook.Activate
Ftwbook.Worksheets("Flat File").Select
Range("Y4").Select
LastPM = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
RIndex = 4
For counter = 0 To LastPM - 1
For Index = 0 To LastCell - 1
If ActiveCell.Value = PM(Index) Then
ActiveCell.EntireRow.Copy
Thiswbook.Worksheets("Project List").Activate
ActiveSheet.Paste Destination:=Range(Cells(RIndex, 1), Cells(RIndex, 1))
Ftwbook.Worksheets("Flat File").Activate
RIndex = RIndex + 1
Exit For
Else
End If
Next Index
ActiveCell.Offset(1, 0).Activate
Next counter
Application.CutCopyMode = False
Ftwbook.Close SaveChanges = no
Application.ScreenUpdating = True
Call LastRowofPM
End Sub
----------------------
Pls help me in this....
Dim Ftwbook As Workbook
Dim Thiswbook As Workbook
Dim LastPM, LastCell, RIndex, counter As Integer
Dim Wksheet As Worksheet
Dim Flatfilename As String
Dim Filewithmacro As String
Application.ScreenUpdating = False
Flatfilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls", Title:="Please choose a file")
Filewithmacro = ThisWorkbook.Name
Set Ftwbook = Workbooks.Open(Filename:=Flatfilename, ReadOnly:=yes)
Set Thiswbook = Workbooks(Filewithmacro)
ThisWorkbook.Worksheets("Project Managers").Activate
Range("A1").Select
LastCell = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
ReDim PM(LastCell) As String
For counter = 0 To LastCell - 1
PM(counter) = ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Next counter
Thiswbook.Worksheets("Project List").Activate
Range("A4", Range("A4").SpecialCells(xlCellTypeLastCell).Address).Rows.ClearContents
Ftwbook.Activate
Ftwbook.Worksheets("Flat File").Select
Range("Y4").Select
LastPM = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
RIndex = 4
For counter = 0 To LastPM - 1
For Index = 0 To LastCell - 1
If ActiveCell.Value = PM(Index) Then
ActiveCell.EntireRow.Copy
Thiswbook.Worksheets("Project List").Activate
ActiveSheet.Paste Destination:=Range(Cells(RIndex, 1), Cells(RIndex, 1))
Ftwbook.Worksheets("Flat File").Activate
RIndex = RIndex + 1
Exit For
Else
End If
Next Index
ActiveCell.Offset(1, 0).Activate
Next counter
Application.CutCopyMode = False
Ftwbook.Close SaveChanges = no
Application.ScreenUpdating = True
Call LastRowofPM
End Sub
----------------------
Pls help me in this....
HI TessaES
Thank you very much for your help.
I tried with this.Here the problem is some rows will be missed from that of the source file.
And one more issue is after column DI i have formulas which links to the share point site but when i run the macro this link gets disconnected and automatically takes from my desktop
Thank you very much for your help.
I tried with this.Here the problem is some rows will be missed from that of the source file.
And one more issue is after column DI i have formulas which links to the share point site but when i run the macro this link gets disconnected and automatically takes from my desktop