VBA: All Sheets data to Master Sheet (excluding some sheet)

[Samantha27]

Hi Good People,

Okay so I'm having a hard time fixing this code that I came across from my research.. What I wanted to achieve is this..

I have a

MasterSheet - Sheet1-Sheet2-Sheet3-NotesSheet, NoteSheet 2.

I have a macro button in the masterfile sheet that will extract the data from Sheet1-Sheet3 but exclude data from notesheet and notesheet 2.

The masterfile have the same heading of sheet1-sheet3 so I just need to extract the data daily. Up to the next available cell, but not over ride the previous data.

below is my code..

Please help me achieve this.. I can't stress this enough.. Below is my code. Thank you!!

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Const strPath As String = "c:\Users\michal\Documents\Macro\"
    ChDir strPath
    strExtension = Dir("*.csv*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets(1).Range("A1:E" & LastRow).Copy wkbDest.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[Max1616]

I would do something like this. Note I didn't test this so it might need some slight changes:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim i As Long
    Const strPath As String = "c:\Users\michal\Documents\Macro\"
    ChDir strPath
    strExtension = Dir("*.csv*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        
        For i = 1 To wkbSource.Sheets.Count
            Set ws = wkbSource.Sheets(i)
            
            LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
            
            If InStr(LCase(ws(i).Name), "notes") = 0 Then
                ws.Range("A1:E" & LastRow).Copy wkbDest.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
            End If
        
        Next i
        
        wkbSource.Close False
       
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[Samantha27]

I would do something like this. Note I didn't test this so it might need some slight changes:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim i As Long
    Const strPath As String = "c:\Users\michal\Documents\Macro\"
    ChDir strPath
    strExtension = Dir("*.csv*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
       
        For i = 1 To wkbSource.Sheets.Count
            Set ws = wkbSource.Sheets(i)
           
            LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
           
            If InStr(LCase(ws(i).Name), "notes") = 0 Then
                ws.Range("A1:E" & LastRow).Copy wkbDest.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
            End If
       
        Next i
       
        wkbSource.Close False
      
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Hi. thank you for noticing.. Actuallyz I paste a wrong code.. It's the same workbook.. Heres my code.. still nowhere near ..

Sub Copy_Sheets_To_Master()

Dim wb As Workbook
Dim ws As Worksheet
Dim i, LastRowa, LastRowd As Long
Dim WSname As String

Set wb = ActiveWorkbook

For Each ws In wb.Sheets

If ws.Name <> "Master" Then

WSname = ws.Name

LastRowa = ws.Cells(Rows.Count, "A").End(xlUp).Row
LastRowd = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row

ws.Range("A14:A" & LastRowa).Copy
Sheets("Master").Range("A" & LastRowd + 2).PasteSpecial Paste:=xlPasteValues
Sheets("Master").Range("A" & LastRowd + 1).Value = WSname

End If

Next ws

End Sub

 

[kevin9999]

Please try the following on a copy of your workbook. Assumes your headers are on row 1, data starting from row 2.

Option Explicit
Sub Copy_Some_Sheets()
Dim ws As Worksheet, wsM As Worksheet
Set wsM = Worksheets("Master")

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Master" And ws.Name Like "Note*" = False Then
        ws.Range(ws.Cells(2, 1), ws.Cells(ws.Cells(Rows.Count, 1).End(xlUp).Row, ws.Cells(1, _
        Columns.Count).End(xlToLeft).Column)).Copy wsM.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End If
Next ws
End Sub

 

[Samantha27]

Please try the following on a copy of your workbook. Assumes your headers are on row 1, data starting from row 2.

Option Explicit
Sub Copy_Some_Sheets()
Dim ws As Worksheet, wsM As Worksheet
Set wsM = Worksheets("Master")

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Master" And ws.Name Like "Note*" = False Then
        ws.Range(ws.Cells(2, 1), ws.Cells(ws.Cells(Rows.Count, 1).End(xlUp).Row, ws.Cells(1, _
        Columns.Count).End(xlToLeft).Column)).Copy wsM.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End If
Next ws
End Sub

first of all. I would like to Thank you for these codes..

I am getting near.. The only problem is al the previous data that were extracted should be excluded in the next extraction.. On column D of their sheets they should be tagged as "done" so it will excluded on my next extraction.. some like, if columnd d = "Done" then exclude..

Thank you

 

[kevin9999]

There's a number of different ways you could do this. Here's just one:

Option Explicit
Sub Copy_Some_Sheets_V2()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, wsM As Worksheet
    Set wsM = Worksheets("Master")
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Master" And ws.Name Like "Note*" = False Then
            ws.Range("A2:C" & ws.Cells(Rows.Count, "A").End(xlUp).Row).Copy wsM.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            ws.Range("D2:D" & ws.Cells(Rows.Count, "A").End(xlUp).Row).Value = "Done"
        End If
    Next ws
    
    wsM.Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
    Application.ScreenUpdating = True
End Sub

 

[Samantha27]

There's a number of different ways you could do this. Here's just one:

Option Explicit
Sub Copy_Some_Sheets_V2()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, wsM As Worksheet
    Set wsM = Worksheets("Master")
   
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Master" And ws.Name Like "Note*" = False Then
            ws.Range("A2:C" & ws.Cells(Rows.Count, "A").End(xlUp).Row).Copy wsM.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            ws.Range("D2:D" & ws.Cells(Rows.Count, "A").End(xlUp).Row).Value = "Done"
        End If
    Next ws
   
    wsM.Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
    Application.ScreenUpdating = True
End Sub

on my next extraction all cases with done should be excluded

 

[kevin9999]

My intention was to keep the code as simple as possible. The values will be copied again - but all duplicates on the Master sheet are then deleted. Please try running the code a few times and you'll see what I mean.

 

[Samantha27]

My intention was to keep the code as simple as possible. The values will be copied again - but all duplicates on the Master sheet are then deleted. Please try running the code a few times and you'll see what I mean.

hi. Yes I Understand. However, I want to keep the previous extracted data but exclude it on my next if their sources are labelled as "Done" in column d. So, all data without Done should be extracted. Continously..

 

[kevin9999]

You end up with the same end result. Please try running the code a few times and you'll see what I mean.