I am having trouble being able to copy the last two columns with data in a worksheet and then insert the same columns to the left of them. Here is my code so far, it copies the correct columns but it just pastes them to the right.
Sub GlobalPerformNewMonths()
Dim lngLastRow As Long
With ThisWorkbook.Worksheets("Global Supplier Performance")
lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Cells(1, .Columns.Count).End(xlToLeft).Offset(,Resize(lngLastRow,Copy .Cells(1, .Columns.Count).End(xlToLeft).Offset(, -2)
Columns("D:AZ").ColumnWidth = 18.43
Application.CutCopyMode = False
End With
End Sub
Try selecting the entire columns of the data you want. Select them and then insert them to the left of the desired column.
Range("d:e").Select
Selection.Copy
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
You will have to shift from the last column found and Range.Resize to the appropropriate cells. To that end, I would suggest working with the Range.Cells property where numerically specific addressing is used.
Sub GlobalPerformNewMonths()
Dim lr As Long, lc As Long
With ThisWorkbook.Worksheets("Global Supplier Performance")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
lc = .Cells(1, Columns.Count).End(xlToLeft).Column
With .Cells(1, lc - 1).Resize(lr, 2)
.Copy
.Insert Shift:=xlToRight
End With
.Columns("D:AZ").ColumnWidth = 18.43
Application.CutCopyMode = False
End With
End Sub
Related
how to copy a group of rows if cells in the first column equal a certain value.
this is the code i found online, but can't seem to get it to work, i think its because I've formated data on the sheet as a table.
Private Sub CommandButton1_Click()
a = Worksheets("inbd").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("inbd").Cells(i, 3).Value = 76 Then
Worksheets("inbd").Rows(i).Copy
Worksheets("sheet2").Activate
b = Worksheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("sheet2").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("sheet1").Activate
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("inbd").Cells(1, 1).Select
End Sub
Example of how table on "inbd" looks:
How about the following, this will filter column A with the relevant criteria and copy the filtered rows into Sheet2, you will need to amend the range as I've used Column A to N, please also bear in mind in the code below I'm filtering Column A to find the value 76, whereas on your original code you were filtering Column C as your code Cells(i, 3).Value = 76 where 3 is the Column number:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("inbd")
Dim wsDestination As Worksheet: Set wsDestination = Sheets("Sheet2")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
ws.Range("A1:N" & LastRow).AutoFilter Field:=1, Criteria1:="76"
'filter data on Column 1 (A), change the Field number from 1 to the column number you wish to filter
ws.Range("A2:N" & LastRow).SpecialCells(xlCellTypeVisible).Copy
'copy filtered results
DestinationRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
'get the destination row
wsDestination.Range("A" & DestinationRow).PasteSpecial xlPasteAll
'paste into Sheet2
Application.CutCopyMode = False
'deselect the copied rows
ws.Range("A1:N" & LastRow).AutoFilter Field:=1
'remove filter
End Sub
I've got this code that I need to simplify otherwise I'll have to copy it at least twelve times so as to cover the months of a year which would probably not be optimized. I am not too sure how to go about doing this.
Sub Test_Copy()
Dim rng As Range
Dim lastRow As Long
With Worksheets("Sheet1")
Set rng = .Range("B3", .Range("B" & .Rows.Count).End(xlUp))
End With
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
Rows(lastRow).Select
With Worksheets("Mai")
Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
Worksheets("Mai").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End With
With Worksheets("Juin")
Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
Worksheets("Juin").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End With
With Worksheets("Juil")
Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
Worksheets("Juil").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End With
End Sub
Firstly, you are using With incorrectly.
With Worksheets("Juin")
Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
Worksheets("Juin").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End With
you would use it like this:
With Worksheets("Juin")
.Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End With
anything starting with . will automatically be against what you set as With. I am not sure if you want the selection doing, I would imagine you need to make a selection first but you haven't indicated what to select before inserting a row.
However, those problems aside, this will do what you want (but you still need to fix the select part of your With.
Sub Test_Copy()
Dim rng As Range, lastRow As Long, MyMonth As Variant
MyMonth = Array("Mai", "Juin", "Juil") ' Put more months in here
Set rng = Worksheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
Rows(lastRow).Select 'I "think" you want to do something with this for selecting within the sheet BUT lastrow is relevant only to the data in Sheet1
For X = LBound(MyMonth) To UBound(MyMonth)
With Worksheets(MyMonth(X))
.Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End With
Next
End Sub
If however, you do not need to select a cell and insert then you can remove that with also and you end up with this:
Sub Test_Copy()
Dim rng As Range, lastRow As Long, MyMonth As Variant
MyMonth = Array("Mai", "Juin", "Juil") ' Put more months in here
Set rng = Worksheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
Rows(lastRow).Select 'I "think" you want to do something with this for selecting within the sheet BUT lastrow is relevant only to the data in Sheet1
For X = LBound(MyMonth) To UBound(MyMonth)
Worksheets(MyMonth(X)).Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
Next
End Sub
This doesn't insert anything, just writes from cell B6 onwards over the top of anything that is there.
Edited to your last comment:
Sub Test_Copy()
Dim rng As Range, MyMonth As Variant
MyMonth = Array("Mai", "Juin", "Juil") ' Put more months in here
Set rng = Sheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
For X = LBound(MyMonth) To UBound(MyMonth)
Sheets(MyMonth(X)).Range("A" & .Cells(Rows.Count, 2).End(xlUp).Row).Resize(rng.Rows.Count, 1).EntireRow.Insert
Sheets(MyMonth(X)).Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
Next
End Sub
Lastly, there was another possibility without using the sheet array that I build in the code and you can use the worksheets object using For each WS in Worksheets, then you can use WS.blahblah to manipulate the sheet but you would need to put a test in there to make sure you don't hit the sheet you are copying from. Either way is technically acceptable.
That code would look something like this:
Sub Test_CopyWS()
Dim rng As Range, WS As Worksheet
Set rng = Sheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
For Each WS In Worksheets
If Not ES.name = "Sheet1" Then
WS.Range("A" & .Cells(Rows.Count, 2).End(xlUp).Row).Resize(rng.Rows.Count, 1).EntireRow.Insert
WS.Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End If
Next
End Sub
On the same worksheet, I'm trying to compact all my cell data, i.e. move all the cells with value to be next to each other instead of spread apart. The original sheet looks like this:
The desired output would be something like this:
I have tried below code to solve this problem, and sorry I'm new here so don't know how to ask the question
Sub SelectRangea()
Sheets("Sheet1").Select
Range("a1:cf1").Select
Application.CutCopyMode = False
Selection.Copy
With Sheets("Sheet1")
lst = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & lst).PasteSpecial xlPasteColumnWidths
.Range("A" & lst).PasteSpecial xlPasteValues
End With
End Sub
This code solves the problem as per your sample data.
Dim c As Long
c = 1
With Worksheets("sheet6")
c = .Cells(1, c).End(xlToRight).End(xlToRight).Column
Do While c < .Columns.Count
With .Range(.Cells(1, c), .Cells(1, c).End(xlToRight))
.Parent.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, .Columns.Count) = .Cells.Value
.Clear
End With
c = .Cells(1, c).End(xlToRight).Column
Loop
End With
If one of the 'islands' of data in the first row is a single cell then you will have to accommodate that special condition.
I currently have a VB macro that will copy-past values from one sheet to another. Currently however, the VB is written in a way that it will do it row-by-row and this runs pretty slow since it goes through a few thousand rows. I'm wondering how would be best to change my VB to do a batch copy-paste to cut down on waiting time. Code is:
Sub copypaste_settlement_rows()
Dim LastRow As Long
Application.ScreenUpdating = False
Sheets("Settlement Template").Select
'find last row in column A
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To LastRow
Cells(x, 1).Resize(1, 42).Copy
Sheets("PIVOT DATA").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Settlement Template").Select
Next x
Sheets(">> START HERE <<").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
This should be instantaneous and it does not use the clipboard:
Sub copypaste_settlement_rows()
Dim v
With Sheets("Settlement Template")
v = .Cells(2, 1).Resize(.Cells(.Rows.Count, "A").End(xlUp).Row, 42)
End With
With Sheets("PIVOT DATA")
.Cells(.Rows.Count, "A").End(xlUp).Resize(UBound(v), UBound(v, 2)) = v
End With
End Sub
An extremely simple way (and the fastest I've seen in my own code) is:
ThisWorkbook.Worksheets("PIVOT DATA").Range("A2:A" & lastRow) = ThisWorkbook.Worksheets("Settlement Template").Range("A2:A" & lastRow).Value
I have 7 tabs in an excel work book. The information in these tabs are all tables. I need to combine these tables so each one starts in the next empty column. The code that I've tried to make starts on the next empty row, instead of the next empty Column.
Basically, I want all of my headers from each table to all be contained in row 1 instead of starting in the next free row.
Sub Combine()
Dim J As Integer
Dim s As Worksheet
Dim NextEmptyCol As Long
NextEmptyCol = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column + 1
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
For Each s In ActiveWorkbook.Sheets
If s.Name <> "Combined" Then
Application.Goto Sheets(s.Name).[A1]
Selection.CurrentRegion.Select
Sheet.UsedRange.Clear
Selection.Copy Destination:=Sheets("Combined"). _
Cells(Columns.Count, 1).End(xlUp)(2)
End If
Next
End Sub
Your code Selection.Copy Destination:=Sheets("Combined").Cells(Columns.Count, 1).End(xlUp)(2) finds the next free row. To find the next free column:
LastCol = Sheets("Combined").Cells(1, Columns.Count).End(xlToLeft).Column
Selection.Copy Destination:=Sheets("Combined"). _
Cells(1, LastCol + 1)