I am trying to copy data from column B in the Resource worksheet to the TEST worksheet.
It´s meant to copy from B7 onwards and I wanted it so that it searched the last row in the TEST one and paste it there using Offset (1,0) but it doesn't seem to work as I had hoped.
Sub CopyName()
Worksheets("TEST").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) =
Worksheets("Resource").Range("B" & Rows.Count).End(xlUp).Value
End Sub
This will
Grab range from Resource starting from B7 down to the last used row in Column B
Move the range to Test on first available non-blank cell
Sub CopyName()
Dim Resource As Worksheet: Set Resource = ThisWorkbook.Sheets("Resource")
Dim Test As Worksheet: Set Test = ThisWorkbook.Sheets("TEST")
Dim ResourceRange As Range
Set ResourceRange = Resource.Range("B7:B" & Resource.Range("B" & Resource.Rows.Count).End(xlUp).Row)
Test.Range("B" & Test.Rows.Count).End(xlUp).Offset(1).Resize(ResourceRange.Rows.Count, 1).Value = ResourceRange.Value
End Sub
Related
I've been trying to figure this out for ages. I've found an answer on StackOverflow but I get object error when trying to use it. I want to copy a set of data from a sheet based on a condition and then paste it in the next empty cell in a column on another sheet. This is my code:
Public list As Worksheet
Public bsawt As Worksheet
Sub Check2()
Set bsawt = Sheets("BSAW_TABLE")
Set list = Sheets("LIST")
lastrow = list.Cells(Rows.Count, "K").End(xlUp).Row
For x = 13 To lastrow
If list.Range("K" & x).Value = "BSAW" Then list.Range("L" & x).Copy Destination:=bsawt.Range("A1").End(xlDown).Offset(1, 0)
Next x
End Sub
If you have nothing in column A, or an entry in A1 only, then copying to this destination
Destination:=bsawt.Range("A1").End(xlDown).Offset(1, 0)
is equivalent to going to the last cell in column A in the worksheet and then attempting to go down one further row, which is clearly an impossibility. See also #PEH's comment.
Instead, work up from the bottom.
Destination:=bsawt.Range("A" & rows.count).End(xlup).Offset(1, 0)
I am having some difficulty with (vba lookup) issue.
I Have a sheet (sheet3) which has multiple rows of data of different invoices (each row of data includes the invoice number it relates to)Data sheet
I have copied the unique invoice numbers into separate sheets, each invoice has its own sheet and the invoice number is in cell B1.invoice sheet
What I want to do is to copy all rows from the data sheet to the sheet with the matching invoice number.
all I have for my current code is this which My separate invoice pages link of rather than using Vba to create them as there will be various other formatting and Formulrs on the page so im pretty much starting from scratch on my issue!
Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("sheet3")
Set s2 = Sheets("Bill Date")
s1.Range("F:G").Copy s2.Range("A:B")
s2.Range("A:B").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Your help will be appreciated
Thanks
In your VBA Macro, do this within a for loop:
Sub copyData()
Dim invNo As String
Dim lastRow As Integer
Dim sourceSht As Worksheet
Dim targSht As Worksheet
Set sourceSht = Worksheets("Sheet3")
'evaluates every data item from row 2 to last populated row
For Row = 2 To sourceSht.Cells(sourceSht.Rows.Count, 1).End(xlUp).Row
invNo = sourceSht.Range("F" & Row).Value
'if invNo blank, skip
If invNo <> "" Then
'try to find the sheet, make if does not exist
invNo = invNo & "_INV"
On Error Resume Next
Set targSht = Worksheets(invNo)
If targSht Is Nothing Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = invNo
Set targSht = Worksheets(invNo)
'SetHeader
End If
'find first empty row in targSht
lastRow = targSht.Cells(targSht.Rows.Count, 1).End(xlUp).Row + 1
'copy row of data
sourceSht.Range("A" & Row & ":L" & Row).Copy
targSht.Range("A" & lastRow & ":L" & lastRow).Select
targSht.Paste
'must do to make more sheets
Set targSht = Nothing
End If
Next
End Sub
I changed some of your specifications in favor of a simpler approach. I assumed the twelve columns you showed me are all you have. I added "_INV" to the end of the invoice sheets because purely numeric sheet names can cause errors. I am also pasting the row of data into the new sheet verbatim. If you keep your current header, you will need to change the order. You may consider changing your targSht header to make it easier. SetHeader is a placeholder for a block of code that sets up the header row in targSht however you want. Please mark correct if this solves your issue.
Demo (without invoice header):
I need a little bit help with a macro of Excel.
I need to create a macro that automatically find users and copy the values that i have in an other Sheet:
I have one sheet with values that contains the Users and their Kills and Deaths, I create 3 sheets more (3 different groups of users), and I need that the macro copy values automatically finding the users and copying values.
Images to describe it better:
----(Copy this values on)----->
You don't need a macro for this, using the worksheetfunction VLOOKUP is sufficient.
As an example, if you have your headers in row 1 and users in column A, what you'd put into cell B2 (the number of kills for the first user) would be =VLOOKUP($A2;Values!$A$2:$C$9;2;FALSE) and C2 would be =VLOOKUP($A2;Values!$A$2:$C$9;3;FALSE).
The arguments for the function (which you can also find in the linked document) is:
First, the value you're looking for, in your case whatever is in A2
Next the array of values which you want to return a result from - vlookup will only look through the first column, but since you want to return results from the other columns we include columns A:C in the formula.
What column in the range you search to return the result from for kills it is column 2, for deaths column 3.
Finally whether you want to have an exact match (false) or if an approximate one is ok (true).
If I understand what you're after, you should be able to do this with VLOOKUPs
(No VBA necessary)
The following source code solve your problem.
Option Explicit
Dim MyResultWorkbook As Workbook
Dim ValuesWorksheet As Worksheet
Dim SniperWorksheet As Worksheet
Dim ARsWorksheet As Worksheet
Sub CopyResult()
Set MyResultWorkbook = ActiveWorkbook
Set ValuesWorksheet = MyResultWorkbook.Sheets("Values")
Set SniperWorksheet = MyResultWorkbook.Sheets("Sniper")
Set ARsWorksheet = MyResultWorkbook.Sheets("Ars")
Dim SniperLastRow As Long
Dim ARLastRow As Long
Dim RowPointer As Long
Dim ValuePointer As Long
ValuePointer = 2
'Update the Sniper worksheets
SniperLastRow = SniperWorksheet.Cells(SniperWorksheet.Rows.Count, "A").End(xlUp).Row
For RowPointer = 2 To SniperLastRow
Do While (SniperWorksheet.Range("A" & RowPointer).Value <> ValuesWorksheet.Range("A" & ValuePointer).Value)
ValuePointer = ValuePointer + 1
Loop
SniperWorksheet.Range("A" & RowPointer).Offset(0, 1).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 1).Value 'copy kill
SniperWorksheet.Range("A" & RowPointer).Offset(0, 2).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 2).Value 'copy death
ValuePointer = 2
Next
'Update the Ars worksheets
ARLastRow = ARsWorksheet.Cells(ARsWorksheet.Rows.Count, "A").End(xlUp).Row
For RowPointer = 2 To ARLastRow
Do While (ARsWorksheet.Range("A" & RowPointer).Value <> ValuesWorksheet.Range("A" & ValuePointer).Value)
ValuePointer = ValuePointer + 1
Loop
ARsWorksheet.Range("A" & RowPointer).Offset(0, 1).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 1).Value 'copy kill
ARsWorksheet.Range("A" & RowPointer).Offset(0, 2).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 2).Value 'copy death
ValuePointer = 2
Next
End Sub
I have 2 Master Sheets based on 2 conditions of location. I import this data from an Excel Workbook into a worksheet on the Master Sheet Workbook. I think it would be better if I was able to scan the first column (A for example) and if the row meets a certain condition it would move the entire row to the respective Master Sheet just below the current data. If it meets condition B it goes to the other master sheet. I can then use Remove Duplicates in Excel to filter the data. My current code is below and I am fairly new to VB Automation. Any ideas on what kind of code I could use to select and move the rows based on criteria into 2 seperate master worksheets?
Sub Copy_DataCDN()
Sheets("CDNDataDump").Range("A2:AC10000").Copy _
Sheets("CDN").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Sheets("CDN").Select
As you suggested, this can be done by looping through the cells in your condition column (in the example code it's column A).
Here's the example code for you to modify.
Sub MoveToSheets()
Dim dataSource As Worksheet: Set dataSource = ThisWorkbook.Sheets(1)
Dim dataTargetA As Worksheet: Set dataTargetA = ThisWorkbook.Sheets(2)
Dim dataTargetB As Worksheet: Set dataTargetB = ThisWorkbook.Sheets(3)
Dim dataSourceRange As Range: Set dataSourceRange = dataSource _
.Range("A1:A" & dataSource.Cells(dataSource.Rows.Count, "A").End(xlUp).Row)
For Each Cell In dataSourceRange
'Test 1 - I'm checking if the cell value is a number as an example.
If IsNumeric(Cell.Value) = True Then
dataTargetA.Range("A" & Rows.Count).End(xlUp).Offset(1).EntireRow.Value _
= Cell.EntireRow.Value
'Test 2 - Checking if the cell value is "e".
ElseIf Cell.Value = "e" Then
dataTargetB.Range("A" & Rows.Count).End(xlUp).Offset(1).EntireRow.Value _
= Cell.EntireRow.Value
End If
Next
End Sub
In the For Each Cell In dataSourceRange loop you can have as many conditions as you need. You could have more sheets to paste to as well.
Background: I have an Excel file used for tracking credit card payables. There are 18 columns of data (A through R). Out of these 18 columns, I want to use a macro to filter for specific statement date and then for a specific company code.
Each company code will be assigned a new worksheet. In each of these worksheets, I want to bring over specific cells from the master worksheet based on the criteria. For instance, the macro should first sort for statement date (7/31/2012) and then company code (ABC). Then, I need to run a loop to bring over details. For instance, in the master worksheet, the GL code in column P needs to be copied to the "ABC" worksheet in column H.
Here's a summary of what needs to happen:
1. Clear any filters in filter range (A2:R2)
2. Filter for date in cell A1 on "Master" worksheet beginning in cell A3 (date column)
3. Filter for company code (ABC) in column O
That should give a data set for particular company's statement activity. Here's what needs to happen next:
4. Copy Column P cell values in "master" worksheet to Column C in "ABC" worksheet
5. Copy Column N cell values in "master" worksheet to Column D in "ABC" worksheet
6. Copy Column R cell values in "master" worksheet to Column H in "ABC" worksheet
7. Copy Column F cell values in "master" worksheet to Column G in "ABC" worksheet, but max of 30 characters
8. If Column G value in "master" worksheet is >=0, then copy that value to Column E in "ABC" worksheet (otherwise needs to be zero)
9. If column G value in "master" worksheet is <0, then copy that value to Column F in "ABC" worksheet (otherwise needs to be zero)
Is this possible?
Here's a sub that should get you started. I did not implement all your steps, but I believe this is enough to take and finish on your own. If you find this answer is helpful to get you where you need to go, please accept this answer. If you have problems with anything here, please add a comment to this answer asking for clarification.
I have only tested on dummy data, but what I did work with was successful.
Option Explicit
Sub TransferData()
Dim Master As Worksheet
Dim NewSheet As Worksheet
Dim CompanyList As Object
Dim lRow As Long, lMaxRow As Long, lNewRow As Long
Dim vDictItem As Variant
Set CompanyList = CreateObject("Scripting.Dictionary")
Set Master = ThisWorkbook.Sheets("Master")
If Master.FilterMode Then
Master.ShowAllData
End If
Master.Range("A:R").Sort Master.Range("A2"), xlAscending, Master.Range("O2"), , xlAscending, , , xlYes
lMaxRow = Master.Range("A" & Master.Rows.Count).End(xlUp).Row
For lRow = 3 To lMaxRow
If Not CompanyList.Exists(Master.Range("A" & lRow).Value) Then
CompanyList.Add Master.Range("A" & lRow).Value, Master.Range("A" & lRow).Value
End If
Next lRow
For Each vDictItem In CompanyList.Keys
Master.Range("A3:R" & lMaxRow).AutoFilter 1, vDictItem
If Master.Cells.SpecialCells(xlCellTypeVisible).Count > 0 Then
Set NewSheet = ThisWorkbook.Worksheets.Add
NewSheet.Name = vDictItem
lNewRow = 1
For lRow = 3 To lMaxRow
If Master.Rows(lRow).Hidden = False Then
lNewRow = lNewRow + 1
NewSheet.Range("C1").Value = Master.Range("P1").Value
NewSheet.Range("C" & lNewRow).Value = Master.Range("P" & lRow).Value
NewSheet.Range("G1").Value = Master.Range("F1").Value
NewSheet.Range("G" & lNewRow).Value = Left(Master.Range("F" & lRow).Value, 30)
NewSheet.Range("E1").Value = Master.Range("G1").Value & " (POS)"
NewSheet.Range("F1").Value = Master.Range("G1").Value & " (NEG)"
If Master.Range("G" & lRow).Value >= 0 Then
NewSheet.Range("E" & lNewRow).Value = Left(Master.Range("G" & lRow).Value, 30)
Else
NewSheet.Range("F" & lNewRow).Value = Left(Master.Range("G" & lRow).Value, 30)
End If
End If
Next lRow
End If
Next vDictItem
End Sub