Currently I have a lot of sheets in my Excel file but I want to get the last row of data in sheets that start with "6" as their names as the other sheets are not relevant. In the sheets that start with 6 are all in the same format but have different number of rows, I am interested in extracting the last row in all those sheets (columns D:J) and placing it into a "master sheet". Since I am quite new to VBA, how would I go about doing that? Thanks in advance!
What I have currently that can copy one sheet and paste into my master sheet "Sheet2":
With Sheets("6363")
With Range(.Cells(.Rows.Count, "D").End(xlUp), _
.Cells(.Cells(.Rows.Count, "D").End(xlUp).row, .Columns.Count).End(xlToLeft))
Worksheets("Sheet2").Range("D1").Resize(, .Columns.Count).Value = .Value
End With
End With
This will copy the last row, columns D-J, from every sheet with a name that starts with '6'.
It will put the copied data into the next empty row, starting at column D, of 'Sheet2'.
Sub CopySix()
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Dim rngSrc As Range
Dim rngDst As Range
Set wsDst = ActiveWorkbook.Sheets("Sheet2")
Set rngDst = wsDst.Range("D" & Rows.Count).End(xlUp).Offset(1)
For Each wsSrc In ActiveWorkbook.Sheets
If Left(wsSrc.Name, 1) = "6" Then
Set rngSrc = wsSrc.Range("D" & Rows.Count).End(xlUp).Resize(, 7)
rngDst.Resize(, 7).Value = rngSrc.Value
Set rngDst = rngDst.Offset(1)
End If
Next wsSrc
End Sub
Related
I have been running into some issues trying to use VBA to compare 2 tables in different worksheets, and then copy any rows in the "Master" sheet that are not found in the "New" sheet. Both tables are formatted as tables. The match is based on an "ID" column in Column A of both tables. If an ID is in the "Master" sheet, but not in the "New" sheet, than that entire row should be copy and pasted to the end of the table in the "New" sheet.
I updated some code found in another forum, which is almost working. However, it only seems to paste over the ID data into Column A, and not the entire corresponding row of data which is needed.
Sub compare()
Dim i As Long
Dim lrs As Long
Dim lrd As Long
With Worksheets("Master")
lrs = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To lrs 'assumes header in row 1
If Application.IfError(Application.Match(.Cells(i, 1), Worksheets("New").Columns(1), 0), 0) = 0 Then
lrd = Worksheets("New").Cells(Worksheets("test").Rows.Count, 1).End(xlUp).Row
Worksheets("New").Cells(lrd + 1, 1).Value = .Cells(i, 1).Value
End If
Next i
End With
End Sub
I think the issue has to do with the "Cells" reference, instead of a range, but I do not know how to make that line dynamic.
Slightly different approach, but you need to use something like Resize() to capture the whole row, and not just the cell in Col A.
Sub compare()
Const NUM_COLS As Long = 10 'for example
Dim wb As Workbook, wsSrc As Worksheet, wsDest As Worksheet
Dim c As Range, cDest As Range
Set wb = ThisWorkbook 'or ActiveWorkbook for example
Set wsSrc = wb.Worksheets("Master")
Set wsDest = wb.Worksheets("New")
Set cDest = wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1) 'next empty row
For Each c In wsSrc.Range("A2:A" & wsSrc.Cells(Rows.Count, 1).End(xlUp).Row).Cells
If IsError(Application.Match(c.Value, wsDest.Columns(1), 0)) Then
cDest.Resize(1, NUM_COLS).Value = c.Resize(1, NUM_COLS).Value
Set cDest = cDest.Offset(1) 'next row
End If
Next c
End Sub
I am brand new to VBA coding and am confused on how I would be able to copy and paste values from one sheet to another if two criteria points are met. In the sheet below I want to copy "12, 9, and 15" and paste it into the "Expected, P10 and P90" cells on sheet2 if the names on sheet one "Orange, Green" match those on sheet 1.
I've been attempting this on my own for quite some time now with now luck.
Attached is the code I started
Sub Copy_Certain_Data()
a = Worksheets("Schedule Results").Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To a
If Worksheets("Schedule Results").Cells(i, 3).Value = "NE2P1" Then
Worksheets("schedule results").Rows(i).Copy
Worksheets("Campaign 1 Data").Activate
Range("F2").Select
ActiveSheet.Paste
Worksheets("Schedule Results").Activate
End If
Next
Application.CutCopyMode = False
End Sub
Below is a basic macro to loop through two worksheets and find the row that has matching values in columns A and B. Then writing the values from the row in sheet 1, columns C:E to the row in sheet 2, columns D:F.
Dim ws1 As Worksheet, ws2 As Worksheet
Dim xCel As Range, yCel As Range
Set ws1 = ThisWorkbook.Sheets("Sheet1") 'change sheet names as needed
Set ws2 = ThisWorkbook.Sheets("Sheet2")
For Each xCel In ws1.Range("A2", ws1.Range("A" & ws1.Rows.Count).End(xlUp)) 'loop sheet1 column A
If xCel.Value = "Orange" And xCel.Offset(, 1).Value = "Green" Then 'when both values are found in row goto sheet2 loop
For Each yCel In ws2.Range("A2", ws2.Range("A" & ws2.Rows.Count).End(xlUp)) 'Loop sheet2 Column A
If yCel.Value = "Orange" And yCel.Offset(, 1).Value = "Green" Then 'when found write values from sheet1 to sheet2
yCel.Offset(, 3).Resize(, 3).Value = xCel.Offset(, 2).Resize(, 3).Value
End If
Next yCel
End If
Next xCel
This should give you a start to get you what you are trying to accomplished based on the code you have tried. Its always best practice to set your variables and also qualify worksheets.
Using .copy and .paste can cause issues because if the cells are not the same size you will get an error stating such and that is why I always set the destination cell value = the source cell value.
Option Explict
Sub Copy_Certain_Data()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Sheets("Schedule Results")
Set wsDest = wb.Sheets("Campaign 1 Data")
Dim LastRow As Long, i As Long
LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
For i = 3 To LastRow
If wsSource.Cells(i, 3).Value = "NE2P1" Then
wsDest.Cells(i, 6) = wsSource.Cells(i, 3)
End If
Next i
End Sub
The program's main function is to copy all the data in the worksheets opened and put it in a worksheet named "consolidated." Everything's working well, however, I want to add a column called "Data Source" wherein it can state where the data came from (e.g. Sheet1, Sheet2). But the thing is, it outputs the wrong sheet name.
I have tried different codes and I have attached what currently works below. I will highlight the part where I assume the problem comes from. I would really appreciate some help as I'm not a coder myself (just learned this a week ago).
For Each wksSrc In ThisWorkbook.Worksheets
'Skip Destination worksheet
If wksSrc.Name <> wksDst.Name And wksSrc.Name <> "Tool" Then
With wksSrc
'Identify the last row and column on this sheet
'so we know when to stop looping through the data
lngLastSrcRowNum = LastOccupiedRowNum(wksSrc)
lngLastSrcColNum = LastOccupiedColNum(wksSrc)
'Identify the last row of the Destination sheet
'so we know where to (eventually) paste the data
lngLastDstRowNum = LastOccupiedRowNum(wksDst)
'Loop through the headers on this sheet, looking up
'the appropriate Destination column from the Final
'Headers dictionary and creating ranges on the fly
For lngIdx = 1 To lngLastSrcColNum
strColHeader = Trim(CStr(.Cells(1, lngIdx)))
'Set the Destination target range using the
'looked up value from the Final Headers dictionary
Set rngDst = wksDst.Cells(lngLastDstRowNum + 1, _
dicFinalHeaders(strColHeader))
'Set the source target range using the current
'column number and the last-occupied row
Set rngSrc = .Range(.Cells(2, lngIdx), _
.Cells(lngLastSrcRowNum, lngIdx))
'Copy the data from this sheet to the destination
rngSrc.Copy Destination:=rngDst
Next lngIdx
Dim TargetColumn As Long
Dim FinalRow As Long
Dim rngAddress As Range
Dim i As Long
With wksDst
FinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngAddress = .Range("A:Z").Find("Data Source")
If Not rngAddress Is Nothing Then
TargetColumn = rngAddress.Column
''''THIS IS THE PART WHERE I ASSUME THE PROBLEM COMES FROM'''''
For i = 1 To FinalRow
.Cells(i, TargetColumn).Value = wksSrc.Name
Next i
End If
End With
End With
End If
Next wksSrc
End Sub
I already added the "Data Source" column but the wksSrc.Name part in the code always outputs only the last worksheet name when it should be different/dynamic depending on the worksheets where I got the data from.
This might help. When I make the i value to 1, it outputs the correct sheet name, however, it replaces the column header with the sheet name and the loop is only done once. When I make the i value to 2, it outputs the wrong sheet name but it starts to output in the correct first blank row of the Data Source column.
As mentioned in the comments. You are looping through the ENTIRE source name column each time. As such, at the end of your process you will be left with the last worksheet looped through. So in order to overcome this you need a StartRow as well as a FinalRow to only loop through data from that sheet. See below code (not tested) but I think you will get the idea of how to implement and it may work off the bat.
For Each wksSrc In ThisWorkbook.Worksheets
'Skip Destination worksheet
If wksSrc.Name <> wksDst.Name And wksSrc.Name <> "Tool" Then
With wksSrc
'Identify the last row and column on this sheet
'so we know when to stop looping through the data
lngLastSrcRowNum = LastOccupiedRowNum(wksSrc)
lngLastSrcColNum = LastOccupiedColNum(wksSrc)
'Identify the last row of the Destination sheet
'so we know where to (eventually) paste the data
lngLastDstRowNum = LastOccupiedRowNum(wksDst)
'Loop through the headers on this sheet, looking up
'the appropriate Destination column from the Final
'Headers dictionary and creating ranges on the fly
For lngIdx = 1 To lngLastSrcColNum
strColHeader = Trim(CStr(.Cells(1, lngIdx)))
'Set the Destination target range using the
'looked up value from the Final Headers dictionary
Set rngDst = wksDst.Cells(lngLastDstRowNum + 1, _
dicFinalHeaders(strColHeader))
'Set the source target range using the current
'column number and the last-occupied row
Set rngSrc = .Range(.Cells(2, lngIdx), _
.Cells(lngLastSrcRowNum, lngIdx))
'Copy the data from this sheet to the destination
rngSrc.Copy Destination:=rngDst
Next lngIdx
Dim TargetColumn As Long
Dim FinalRow As Long, StartRow As Long
Dim rngAddress As Range
Dim i As Long
With wksDst
Set rngAddress = .Range("A:Z").Find("Data Source")
If Not rngAddress Is Nothing Then
TargetColumn = rngAddress.Column
'set the start for this sheet
StartRow = lngLastDstRowNum + 1
'set the final row for this worksheet
FinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range(.Cells(StartRow, TargetColumn), .Cells(FinalRow, TargetColumn)).Value = wksSrc.Name
End If
End With
End With
End If
Next wksSrc
As can be seen your range adjustment on the wksDst should take into account the sheets data.
I have this code where it loops through all the sheets in the workbook and copies the value in F9 of each sheet and pastes it in "Summary" sheet column A. How can I also print the sheet name in column B? So the value is next to the sheet name in the "Summary" sheet.
code:
Sub loopsheet()
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "Summary" Then
wks.Range("F9:F" & wks.Cells(Rows.Count, "F").End(xlUp).Row).Copy _
Destination:=Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End Sub
Thank you
Create two variables to track the last rows of your sheets as you loop. This will help with readability in your code. The combination of these two variables can also help you deduce the size of the range where you need to drop your sheet name.
I believe cLR + pLR - 11 is the size of range. The offset is due to headers, LR offset, and the fact that you are starting your copy from the 9th row. After you run this, you may need to tweak it up or down one if i'm wrong.
Option Explicit
Sub LoopSheet()
Dim ws As Worksheet
Dim Summary As Worksheet: Set Summary = ThisWorkbook.Sheets("Summary")
Dim cLR As Long, pLR As Long
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> Summary.Name Then
cLR = ws.Range("F" & ws.Rows.Count).End(xlUp).Row
pLR = Summary.Range("A" & Summary.Rows.Count).End(xlUp).Offset(1).Row
ws.Range("F9:F" & cLR).Copy Summary.Range("A" & pLR)
Summary.Range(Summary.Cells(pLR, 2), Summary.Cells(cLR + pLR - 11, 2)).Value = ws.Name
End If
Next ws
End Sub
Hi I'm looking to create code for copying certain columns (AH to AX) across all worksheets then skipping worksheets named "Aggregated" & "Collated Results"
I have this already
Sub FillSheets()
Dim ws As Worksheets
Dim worksheetsToSkip As Variant
Dim rng As Range
Dim sh As Sheet1
Set rng = sh.Range("AH1:AX7200")
worksheetsToSkip = Array("Aggregated", "Collated Results")
For Each ws In Worksheets
If IsError(Application.Match(ws.Name, worksheetsToSkip, 0)) Then
End Sub
This will
Loop through sheets
"Copy" data from AH1 - AX1 down to the last used row that is determined by Column AH (Update column if needed)
"Paste" data on a sheet named Sheet1 (Update if needed). The data will be pasted in Column AH on the first available blank row. It's not clear what column you want to paste the data in. You just need to change AH to Some Column to modify
"Copy" and "Paste" are in quotes because we are really just transferring values here since this is quicker. We are actually setting the values of two equal sized ranges equal to each other.
Option Explicit
Sub AH_AX()
'Update "Sheet1" to sheet where data is being pasted
Dim ms As Worksheet: Set ms = ThisWorkbook.Sheets("Sheet1")
Dim ws As Worksheet, wsLR As Long, msLR As Long
Dim CopyRange As Range, PasteRange As Range
For Each ws In Worksheets
If ws.Name <> "Aggregated" And ws.Name <> "Collated Results" Then
'Determine last rows
wsLR = ws.Range("AH" & ws.Rows.Count).End(xlUp).Row
msLR = ms.Range("AH" & ms.Rows.Count).End(xlUp).Offset(1).Row
'Set Ranges
Set CopyRange = ws.Range("AH1:AX" & LR)
Set PasteRange = ms.Range("AH" & msLR).Resize(CopyRange.Rows.Count, CopyRange.Columns.Count)
'Value Transfer (Quicker than copy/paste)
PasteRange.Value = CopyRange.Value
End If
Next ws
End Sub