• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA snippet to select a particular range & copy

M

Mr.Karr

Member
Hi,

With the below code, I'm trying to select a particular range ("A21:LR") and paste that into another sheet the same range at A21. But for some reasons I cannot connect to the particular range. Can anyone please look into this?

Code: 
For Each wsData In wbData.Worksheets            'cycle through the sheets
            Set wsMain = wbMain.Sheets(wsData.Name)    'try to match the sheetnames
            If Not wsMain = Array("sheet1", "sheet2") Then              'only proceed if a matching sheetname was found
                NR = wsMain.Range("A" & Rows.Count).End(xlUp).Row + 1  'next empty row
                With wsData                            'measure the used rows then copy
                    LR = .Range("A" & .Rows.Count).End(xlUp).Row
                    .Range("A2:A" & LR).EntireRow.Copy wsMain.Range("A" & NR)
                End With
                Set wsMain = Nothing
            End If
        Next wsData
 
Hi ,

wsMain is a variable of type Worksheet ; the statement

If Not wsMain = Array("sheet1" , "sheet2")

will not work for 2 reasons :

1. You cannot check for whether an item exists in an array by just using the construct you have used

2. The items on the right side are strings , whereas the item on the left is a Worksheet object.

It is better to use the Instr function and make the Array construct into a string , as in "sheet1|sheet2"

A check such as :

If Instr(1,"sheet1|sheet2",wsMain.Name) > 0 Then

will be satisfied if the name of the worksheet wsMain is either sheet1 or sheet2 ; of course , it will also be satisfied if it is heet1 or et1 or any other substring of the string "sheet1|sheet2".

Check out this link for another way to check whether an item exists in an array.

http://stackoverflow.com/questions/10951687/how-to-search-for-string-in-ms-access-vba-array

Narayan
 
@NARAYANK991 : thanks for the info. Can you also help me how to select a particular range?
As it was explained right before, to copy from A21 to LR and paste the selection to the sheet that matches to the same name?
 
Hi Portucale ,

The construct .Rows.Count is used when it has already been qualified using a statement such as :

With Activesheet

or any other equivalent statement. Otherwise , without this With statement preceding it , using it as .Rows.Count will generate an error.

Generally , since all worksheets have the same maximum number of rows , using Rows.Count will work , since all it stands for is the number 1048576.

Narayan
 
@NARAYANK991 : Sure, here are the sample files. Also a bit of change in mechanism.

Summary: There are 2 files attached here. Data & Update. Data is the file which users are already utilizing and where data resides. Update is the file where we need to paste all data into.

We have a macro button in data file. As soon as user clicks, it opens up 'Update' file and copies data from data file of sheet1, sheet2

Both the sheets are saved in the same folder. Or if you can keep an MSO option to open up a folder option would be great.
The main intention behind developing this is to allow users to comfortably pass on data into the new file.

Please let me know if you have any questions. Files attached.
 

Attachments

  • Data.xlsm
    37 KB · Views: 2
  • Update.xlsm
    15.9 KB · Views: 1
Hi ,

See if this works :
Code: 
Sub ConsolidateSheetsFromWorkbooks()
    Dim wbData As Workbook, wbMain As Workbook
    Dim wsMain As Worksheet, wsData As Worksheet
    Dim LR As Long, NR As Long
    Dim fPath As String, fName As String

    Set wbMain = ThisWorkbook          'keeps destination focus on this workbook
                                        'if files are stored in separate directory edit fPath
    fPath = ThisWorkbook.Path & "\"    'don't forget the final \
                                   
    fName = Dir(fPath & "*.xls*")        'start looping through files one at a time
    Application.ScreenUpdating = False  'speed up macro
    On Error Resume Next                'allow macro to proceed if sheetname matches are missing

    Do While Len(fName) > 0            'process one workbook at a time
      If fName <> ThisWorkbook.Name Then
          Set wbData = Workbooks.Open(fPath & fName)      'open the next resource workbook
          For Each wsData In wbData.Worksheets            'cycle through the sheets
              Set wsMain = wbMain.Sheets(wsData.Name)    'try to match the sheetnames
              If InStr(1, "Sheet1|Sheet2", wsMain.Name) > 0 Then            'only proceed if a matching sheetname was found
                NR = wsMain.Range("A" & Rows.Count).End(xlUp).Row + 1  'next empty row
                With wsData                            'measure the used rows then copy
                      LR = .Range("A" & .Rows.Count).End(xlUp).Row
                      .Range("A2:A" & LR).EntireRow.Copy wsMain.Range("A" & NR)
                End With
                Set wsMain = Nothing
              End If
          Next wsData
       
          wbData.Close False
      End If
   
      fName = Dir                'queue up next filename
    Loop

    Application.ScreenUpdating = True      'update screen, back to normal
    MsgBox "complete"
    Call filesavedialog
End Sub
Narayan
 
yes, it works like a breeze.
But it's coping slicers and other pictures/macro buttons too. Can we either remove all of them before copying data? Or any suggestions?
That's the reason why I wanted to copy from Cell A21 across sheets.
Please advise.
 
Hi ,

In that case , what is the range you wish to copy ? I went with what ever was already there in your code.

We can modify the range within the code.

Narayan
 
Sorry I am bit confused. This doesn't copy pasting the data into 'Update' file rather keeping data to itself & just showing up a new workbook to save as. :(

@NARAYANK991 : This automation shows up the save as dialogue for 'Data' file but my requirement is to save 'Update' file with data copied.
 
Hi ,

Can you tell me the source and the destination ? I assume this has been set correctly within the code. I have not checked for this.

Narayan
 
sure. Data is the source file & where the macro button is.
Update is the destination file to be opened up, move data and show save as dialogue.
Sorry for the earlier confusion
 
Hi ,

Please verify whether the coding is correct ; using names such as wbSource and wsSource , wbDestination and wsDestination is better than using wbMain and wbData.

It is late for me , and I will be logging out soon.

Code: 
Sub ConsolidateSheetsFromWorkbooks()
    Dim wbSource As Workbook, wbDestination As Workbook
    Dim wsDestination As Worksheet, wsSource As Worksheet
    Dim LR As Long, NR As Long
    Dim fPath As String, fName As String

    Set wbSource = ThisWorkbook    'keeps destination focus on this workbook
                                        'if files are stored in separate directory edit fPath
    fPath = ThisWorkbook.Path & "\"    'don't forget the final \
                                   
    fName = Dir(fPath & "*.xls*")        'start looping through files one at a time
    Application.ScreenUpdating = False  'speed up macro
    On Error Resume Next                'allow macro to proceed if sheetname matches are missing

    Do While Len(fName) > 0            'process one workbook at a time
      If fName <> ThisWorkbook.Name Then
          Set wbDestination = Workbooks.Open(fPath & fName)                    'open the next resource workbook
          For Each wsSource In wbSource.Worksheets                              'cycle through the sheets
              Set wsDestination = wbDestination.Sheets(wsSource.Name)          'try to match the sheetnames
              If InStr(1, "Sheet1|Sheet2", wsDestination.Name) > 0 Then        'only proceed if a matching sheetname was found
                NR = wsDestination.Range("A" & Rows.Count).End(xlUp).Row + 1  'next empty row
                With wsSource                                                  'measure the used rows then copy
                      LR = .Range("A" & .Rows.Count).End(xlUp).Row
                      .Range("A21:A" & LR).EntireRow.Copy wsDestination.Range("A" & NR)
                End With
                Set wsDestination = Nothing
              End If
          Next wsSource
       
          wbDestination.Close True
      End If
   
      fName = Dir                'queue up next filename
    Loop

    Application.ScreenUpdating = True      'update screen, back to normal
    MsgBox "complete"
    Call filesavedialog
End Sub
Narayan
 
@NARAYANK991 : yes it does captures the data correctly. Now how can we ask users to save a copy of the 'Update' file ? by showing save as dialogue.

Also, 'update' file will act as a template and will not allowed users to save data on that file
 
You must log in or register to reply here.
Back
Top