coppertop18
New Member
- Joined
- Apr 30, 2009
- Messages
- 29
The Test tab data is split based on ‘Region’. The entire row is copied to its respected tab only when “Update Records” button is pressed.
What I’d like to have is the following:
Instead of coping the entire row, I want only to copy the Emp ID. This way, I can then add ‘vlookup’ to each of the rows. Then my data will be autoupdated as soon as I update the master file (Test tab)… and without me clicking again on the “Update Records” button.
Can someone help updating the proper range in the VBA so that only Column A (Emp ID) is copied to the respected tab? VBA code below
Option Explicit
Sub Copy_n_Paste()
On Error Resume Next
Dim srchtrm As String
Dim rng As Range, destRow As Long
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim c As Range
Dim i As Integer
Dim Today As Date
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set shtSrc = Sheets("Test") 'source sheet
Set shtDest = Sheets("JL_1") 'destination sheet
destRow = 24 'start copying to this row
'don't scan the entire column...
Set rng = Application.Intersect(shtSrc.Range("B:B"), shtSrc.UsedRange)
For Each c In rng.Cells
If c.Value = "west" Then
c.EntireRow.Copy shtDest.Cells(destRow, 1) 'change range to columns 1 and 2
destRow = destRow + 1
End If
Next
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Application.CutCopyMode = False
Sheets("Test").Range("A1").Select
'new sheet
On Error Resume Next
Set shtSrc = Sheets("Test") 'source sheet
Set shtDest = Sheets("JL_2") 'destination sheet
destRow = 24 'start copying to this row
'don't scan the entire column...
Set rng = Application.Intersect(shtSrc.Range("B:B"), shtSrc.UsedRange)
For Each c In rng.Cells
If c.Value = "north" Then
c.EntireRow.Copy shtDest.Cells(destRow, 1)
destRow = destRow + 1
End If
Next
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Application.CutCopyMode = False
Sheets("Test").Range("A1").Select
'new sheet
On Error Resume Next
Set shtSrc = Sheets("Test") 'source sheet
Set shtDest = Sheets("JL_3") 'destination sheet
destRow = 24 'start copying to this row
'don't scan the entire column...
Set rng = Application.Intersect(shtSrc.Range("B:B"), shtSrc.UsedRange)
For Each c In rng.Cells
If c.Value = "south" Then
c.EntireRow.Copy shtDest.Cells(destRow, 1)
destRow = destRow + 1
End If
Next
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Application.CutCopyMode = False
Sheets("Test").Range("A1").Select
End Sub
What I’d like to have is the following:
Instead of coping the entire row, I want only to copy the Emp ID. This way, I can then add ‘vlookup’ to each of the rows. Then my data will be autoupdated as soon as I update the master file (Test tab)… and without me clicking again on the “Update Records” button.
Can someone help updating the proper range in the VBA so that only Column A (Emp ID) is copied to the respected tab? VBA code below
Option Explicit
Sub Copy_n_Paste()
On Error Resume Next
Dim srchtrm As String
Dim rng As Range, destRow As Long
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim c As Range
Dim i As Integer
Dim Today As Date
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set shtSrc = Sheets("Test") 'source sheet
Set shtDest = Sheets("JL_1") 'destination sheet
destRow = 24 'start copying to this row
'don't scan the entire column...
Set rng = Application.Intersect(shtSrc.Range("B:B"), shtSrc.UsedRange)
For Each c In rng.Cells
If c.Value = "west" Then
c.EntireRow.Copy shtDest.Cells(destRow, 1) 'change range to columns 1 and 2
destRow = destRow + 1
End If
Next
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Application.CutCopyMode = False
Sheets("Test").Range("A1").Select
'new sheet
On Error Resume Next
Set shtSrc = Sheets("Test") 'source sheet
Set shtDest = Sheets("JL_2") 'destination sheet
destRow = 24 'start copying to this row
'don't scan the entire column...
Set rng = Application.Intersect(shtSrc.Range("B:B"), shtSrc.UsedRange)
For Each c In rng.Cells
If c.Value = "north" Then
c.EntireRow.Copy shtDest.Cells(destRow, 1)
destRow = destRow + 1
End If
Next
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Application.CutCopyMode = False
Sheets("Test").Range("A1").Select
'new sheet
On Error Resume Next
Set shtSrc = Sheets("Test") 'source sheet
Set shtDest = Sheets("JL_3") 'destination sheet
destRow = 24 'start copying to this row
'don't scan the entire column...
Set rng = Application.Intersect(shtSrc.Range("B:B"), shtSrc.UsedRange)
For Each c In rng.Cells
If c.Value = "south" Then
c.EntireRow.Copy shtDest.Cells(destRow, 1)
destRow = destRow + 1
End If
Next
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Application.CutCopyMode = False
Sheets("Test").Range("A1").Select
End Sub