1
Private Sub CommandButton1_Click()
'To count sheets in excel file

totalsheets = Worksheets.Count

For i = 1 To totalsheets
       If Worksheets(i).Name <> "MasterSheet" Then
       'cheking last filled row on each sheet
       lastrow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row
             For j = 1 To lastrow
             Worksheets(i).Activate
             Worksheets(i).Cells(j, 2).Select
             Selection.Copy
             Worksheets("MasterSheet").Activate
             lastcln = Worksheets("MasterSheet").Cells(1, Columns.Count).End(xlToLeft)
             
             Worksheets("MasterSheet").Cells(j, lastcln + 1).Select
             ActiveSheet.Paste

         Next
       End If
    
Next

End Sub
BigBen
  • 46,229
  • 7
  • 24
  • 40
Lotfi Ronin
  • 11
  • 1
  • 2
    It would be better to copy the whole column rather than a cell at a time. So `worksheets(i).columns(2).copy` What is wrong with your code can you show where youre having issues? Also, dont use activate etc, and dont put it in your row loop, this needs to be before, for example if you have 1000 rows, you're activating worksheets(i) 1000 times – Nathan_Sav Aug 16 '21 at 12:31
  • **1.** No need to select or activate. You may want to see [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) **2.** No need to copy cell by cell. Simply copy the entire range and and do a pastespecial transpose. There may be a problem if you last row is more `16384` rows – Siddharth Rout Aug 16 '21 at 12:32
  • @Nathan : we I run my code it gives error at that ligne: ActiveSheet.Paste ; As you said " activate " should be out the loop, for more effciency. – Lotfi Ronin Aug 16 '21 at 15:21
  • @LotfiRonin Hi, yes, just outside the loop, so the line before the for next loop for J needs to be activate, or even just after the for next for I. – Nathan_Sav Aug 17 '21 at 07:53

2 Answers2

0

Try this

For i = 1 To totalsheets
    If Worksheets(i).Name <> "MasterSheet" Then
        ' change this according to your need
        firstrow = 1 
        
        'last row of source
        lastrow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row  
        
        'last column of destination
        lastcln = Worksheets("MasterSheet").Cells(1, Columns.Count).End(xlToLeft)   
        
        'more efficient procedure as suggested by Nathan
        Worksheets("MasterSheet").Cells(firstrow, lastcln + 1).Value = Worksheets(i).Range(Cells(firstrow, 2), Cells(lastrow, 2)).Value     

    End If    
Next
Wils Mils
  • 613
  • 4
  • 9
  • 2
    Could even say `Worksheets("MasterSheet").Cells(firstrow, lastcln + 1).value=Worksheets(i).Range(Cells(firstrow, 2), Cells(lastrow, 2)).value` And maybe `for each ws in worksheets` and use `ws` instead of `worksheets(i)` – Nathan_Sav Aug 16 '21 at 12:51
  • 1
    @Nathan_Sav: You are mistaken. In this way only the value of the first cell will be copied (assigned). The syntax is: `dCell.Resize(srg.Rows.Count).Value = srg.Value` for a one-column range or `dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value` for any range. You will easily make the code more readable and avoid these mistakes by using variables. – VBasic2008 Aug 16 '21 at 13:33
  • @VBasic2008 Apologies, yes. – Nathan_Sav Aug 16 '21 at 13:46
  • You forgot the 'trailing' `.Column` in `lastcln = ...` and the more efficient part is wrong. Try `Set dCell = Worksheets("MasterSheet").Cells(firstrow, lastcln + 1)` and `Set srg = Worksheets(i).Range(Worksheets(i).Cells(firstrow, 2), Worksheets(i).Cells(lastrow, 2))`, when you can finally do: `dCell.Resize(srg.Rows.Count).Value = srg.Value`. – VBasic2008 Aug 16 '21 at 13:50
0

Copy Column From Multiple Worksheets

Option Explicit

Sub CopyColumn()
    
    ' Source
    Const sfRow As Long = 1
    Const sCol As String = "B"
    ' Destination
    Const dName As String = "MasterSheet"
    Const dfRow As Long = 1
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim wsrCount As Long: wsrCount = wb.Worksheets(1).Rows.Count
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dfCell As Range ' Note that the left-most column cannot be column 'A'.
    Set dfCell = dws.Cells(dfRow, dws.Columns.Count).End(xlToLeft).Offset(, 1)
    
    ' Declare additional variables.
    Dim sws As Worksheet ' Source Worksheet
    Dim srg As Range ' Source Range
    Dim slCell As Range ' Source Last Cell
    Dim drg As Range ' Destination Range

    ' Copy.
    For Each sws In wb.Worksheets
        If StrComp(sws.Name, dName, vbTextCompare) <> 0 Then
            Set slCell = sws.Cells(wsrCount, sCol).End(xlUp)
            Set srg = sws.Range(sws.Cells(sfRow, sCol), slCell)
            ' Either for values only (more efficient)...
            Set drg = dfCell.Resize(srg.Rows.Count)
            drg.Value = srg.Value
            ' ... or for values, formats, formulas:
            'srg.Copy dfCell ' no need for 'drg'.
            ' (A third, most flexible option is to use 'PasteSpecial'.)
            Set dfCell = dfCell.Offset(, 1) ' next column
        End If
    Next sws

End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28