Visual Basic - copying data from diff. tabs

Tags:
visual basic
script
August 25, 2010 at 08:43:48
Specs: Windows XP
Hi guys. I need script in VB which will ask from which worksheet data needs to be copied (from the same work book) and when copy columns B, C, L and S from requested worksheet to the columns G, I, K and M in worksheet FD relatively. And if possible it needs to copy from row 3 and start to paste from row 3 as well.
Thanks

See More: Visual Basic - copying data from diff. tabs

Report •

#1
August 25, 2010 at 09:46:36
What do you mean by "copy ... to the columns G, I, K and M in worksheet FD relatively"?

What does relatively mean in this case?

One other question:

Do we need to be concerned with the length of each copied column?

In other words, if we paste 50 rows of data into Column G from one sheet, but the next time we paste in the data there are only 25 rows, do we need to clear the "extra" data in Column G?

Obviously it would be easier if we had a set number of rows to copy, but it's also possible to clear the columns in the FD sheet, determine the length of each copied column and then do the paste.

Your answer will determine how much code has to be written.


Report •

#2
August 25, 2010 at 12:00:12
Relatively mean that it should paste in order as i gave: B to G, C to I, L to K, S to M.

Each time will be different number of rows. Thing is that I have 20 different worksheets in the workbook, so when i need that when i will run the script it should ask from which worksheet data I need and it will be perfect if it will clean "extra" data.

P.S. number of rows in same worksheet will be same for each column


Report •

#3
August 25, 2010 at 13:33:11
I believe the correct word is "respectively" not "relatively".

In any case, attach this code to a button and test it in a backup copy of your workbook. Macros can not be undone and it would be a shame to blow up your only copy of the workbook.

Option Explicit
Sub CopyData_Click()
Dim CopyFromSheetName, tstName As String
Dim lastSrc_rw, lastDst_rw As Integer
GetSheetName:
'Get Sheet Name From User
  CopyFromSheetName = _
    Application.InputBox("Please Enter Sheet Name", _
                         "Copy From Which Sheet?")
'Exit If User Clicks Cancel
  If CopyFromSheetName = "False" Then Exit Sub
'Test for Valid Sheet Name, Display MsgBox if not.
    On Error GoTo InvalidSheetName
     tstName = Sheets(CopyFromSheetName).Name
''Code section to Clear Range in FD
   With Sheets("FD")
'Find last used row in FD
    lastDst_rw = .Range("G" & Rows.Count).End(xlUp).Row
'Clear old data
     .Range("G3:G" & lastDst_rw).ClearContents
     .Range("I3:I" & lastDst_rw).ClearContents
     .Range("K3:K" & lastDst_rw).ClearContents
     .Range("M3:M" & lastDst_rw).ClearContents
   End With
''Code section to Copy Data
'Find last used row in Sheet Named by User
   With Sheets(CopyFromSheetName)
    lastSrc_rw = .Range("B" & Rows.Count).End(xlUp).Row
'Copy data
     .Range("B3:B" & lastSrc_rw).Copy Destination:=Sheets("FD").Range("G3")
     .Range("C3:C" & lastSrc_rw).Copy Destination:=Sheets("FD").Range("I3")
     .Range("L3:L" & lastSrc_rw).Copy Destination:=Sheets("FD").Range("K3")
     .Range("S3:S" & lastSrc_rw).Copy Destination:=Sheets("FD").Range("M3")
   End With
'We're Done!
 Exit Sub
'Error handler for Invalid Sheet Name
InvalidSheetName:
 MsgBox "Invalid Sheet Name. Please Try Again"
 Resume GetSheetName
End Sub


Report •

Related Solutions
See More ↓

#4
August 26, 2010 at 02:20:42
Thank you:) Working perfectly:)

P.S. yeah used wrong word:)


Report •

#5
August 26, 2010 at 04:51:29
Could you change script, that it will paste values? I have formulas in columns L and S and it copying formula now.

Report •

#6
August 26, 2010 at 18:29:43
Option Explicit
Sub CopyData_Click()
Dim CopyFromSheetName, tstName As String
Dim lastSrc_rw, lastDst_rw As Integer
GetSheetName:
'Get Sheet Name From User
  CopyFromSheetName = _
    Application.InputBox("Please Enter Sheet Name", _
                         "Copy From Which Sheet?")
'Exit If User Clicks Cancel
  If CopyFromSheetName = "False" Then Exit Sub
'Test for Valid Sheet Name, Display MsgBox if not.
    On Error GoTo InvalidSheetName
     tstName = Sheets(CopyFromSheetName).Name
''Code section to Clear Range in FD
   With Sheets("FD")
'Find last used row in FD
    lastDst_rw = .Range("G" & Rows.Count).End(xlUp).Row
'Clear old data
     .Range("G3:G" & lastDst_rw).ClearContents
     .Range("I3:I" & lastDst_rw).ClearContents
     .Range("K3:K" & lastDst_rw).ClearContents
     .Range("M3:M" & lastDst_rw).ClearContents
   End With
''Code section to Copy Data
'Find last used row in Sheet Named by User
   With Sheets(CopyFromSheetName)
    lastSrc_rw = .Range("B" & Rows.Count).End(xlUp).Row
'Copy data
     .Range("B3:B" & lastSrc_rw).Copy
       Sheets("FD").Range("G3").PasteSpecial Paste:=xlValues
     .Range("C3:C" & lastSrc_rw).Copy
       Sheets("FD").Range("I3").PasteSpecial Paste:=xlValues
     .Range("L3:L" & lastSrc_rw).Copy
       Sheets("FD").Range("K3").PasteSpecial Paste:=xlValues
     .Range("S3:S" & lastSrc_rw).Copy
       Sheets("FD").Range("M3").PasteSpecial Paste:=xlValues
   End With
'We're Done!
 Exit Sub
'Error handler for Invalid Sheet Name
InvalidSheetName:
 MsgBox "Invalid Sheet Name. Please Try Again"
 Resume GetSheetName
End Sub


Report •
Start a discussion

Ask Question