VBA to copy data from multiple workbooks into one sheet if condition met

lmcadams

New Member
Joined
Aug 20, 2019
Messages
4
I may have seriously gotten in over my head with a project when it's been a while since I coded.

Basically I have a workbook that has a sheet for each month (12) January 2019 to December 2019, I need certain information (Column A B C D E F G H I) to compile to one main sheet in the next available row, without deleting or overwriting any data if Column J = Yes in each of the 12 sheets.

I feel like I just jumped off deep end with this project! It may not be as difficult as I've let my frustrated brain think it is, if anyone can offer some advice please.
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

=ODIN=

Active Member
Joined
Dec 3, 2009
Messages
288
I'm not sure how comfortable you are with coding, but my advice would be to code it this way (pseudo code below)

Code:
dim pasteRow as long 'will keep track of next unused row on main sheet for pasting to

pasteRow = lastUserRowOnMainSheet 'there are several ways to find this.

For each sheet in workbook
   If sheet.name <> yourMainSheetsName 'dont do things to mainSheet
      turn off all sheet filters 
      apply an advanced filter to the sheet 'advanced filters could filter column a:j for yes and paste the result to the mainSheet (on the pasteRow) at the same time
      pastRow = lastUserRowOnMainSheet 
   end if
next sheet
 

lmcadams

New Member
Joined
Aug 20, 2019
Messages
4
This is what I have and running into error. Please remember I am extremely rusty in coding ability!

Code:
For Each ws In ActiveWorkbook.Worksheets
 
      If ws.Name = "Sheet3" Or ws.Name = "Jan" Then
      
        Set columnJ = ws.Range("J:J") 'columnJ
        For Each c In columnJ
          
          If WorksheetFunction.IsText(c.Value) Then
            If InStr(c.Value, "Yes") > 0 Then
              c.ws.Range("A:I").Copy
              destinationWorksheet.Cells(count, 1).pasteRow = lastUserRowOndestinationWorksheet
              count = count + 1
            End If
          End If
        Next c
            
      End If
 
  Next ws
This line I am getting error.
 

lmcadams

New Member
Joined
Aug 20, 2019
Messages
4
My error line didn't post, destinationWorksheet.Cells(count,1).pasteRow is line am getting error on.
 

lmcadams

New Member
Joined
Aug 20, 2019
Messages
4
This is my basic code for one sheet, then last part copied for each additional sheet.

Code:
Public Sub sCopyRows()

  Dim ws As Worksheet
  Dim destinationWorksheet As Worksheet
  Dim columnJ As Range
  Dim c As Range
  Dim pasteRow As Long
 
  Set destinationWorksheet = ActiveWorkbook.Worksheets("BoB")
 
  destinationWorksheet.Cells.ClearContents
 
  count = 1
  For Each ws In ActiveWorkbook.Worksheets("BoB")
 
      If ws.Name = "Sheet3" Or ws.Name = "Jan" Then
      
        Set columnJ = ws.Range("J:J") 'columnJ
        For Each c In columnJ
          
          If WorksheetFunction.IsText(c.Value) Then
            If InStr(c.Value, "Yes") > 0 Then
              c.ws.Range("A:I").Copy
              destinationWorksheet.Cells(count, 1).pasteRow = lastUserRowOndestinationWorksheet
              count = count + 1
            End If
          End If
        Next c
            
      End If
 
  Next ws
 

Watch MrExcel Video

Forum statistics

Threads
1,102,369
Messages
5,486,449
Members
407,547
Latest member
Sankarasrinivas

This Week's Hot Topics

Top