how to use jagged array for copy and pasting specific columns(like B,J,N,M,U,V,) from 12 xl sheets and finally it has to stored in a seperate single sheet.
For Example:
In Sheet1 I need B,J,N,M has to be copied
In Sheet2 I need B,J,N,O,U,V,X,AO to be copied
.
.
.
Upto Sheet12 I need like this specific columns and its values till its last row has to be copied and finally 12 sheet values has to be pasted at the end of the new worksheet.Pls someone help me using vba
I'm gonna try. Is it something like this? Alter the code to your need of course and set more arrays for the column indexes if you need. This will paste all of these columns on a new sheet.
Sub test()
Dim a() As Variant
Dim wb As Workbook
Dim newWS As Worksheet
Dim nextColumn As Long, lastrow As Long, i As Long, o As Long
Set wb = ThisWorkbook
Set newWS = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
a = Array(1, 4, 6, 8, 10, 11) 'column indexes
With wb
nextColumn = 1
For i = 1 To 12
With .Worksheets(i)
For o = LBound(a) To UBound(a)
lastrow = .Cells(65536, a(o)).End(xlUp).Row
.Range(.Cells(1, a(o)), .Cells(lastrow, a(o))).Copy
newWS.Cells(1, nextColumn).PasteSpecial xlPasteAll
nextColumn = nextColumn + 1
Next o
End With
Next i
End With
End Sub
Related
I don't have experience using arrays in VBA and I got lost. What I try to do is the following:
In the column A I have ~15 strings (number is not fixed sometimes it is more sometimes less)
I remove duplicates and then for each name in the column A I would like to create separate sheet in the file.
I created an array to which I tried to assign each name from A with this loop:
Sub assigningvalues()
Dim i As Integer
Dim myArray(20) As Variant
Dim finalrow As Long
ActiveSheet.Range("A1", Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
finalrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
'For i = 2 To finalrow -> I get overflow error when I use this range
For i = 2 To Cells(20, 1)
myArray(i) = Cells(i, 1).Value
Next i
'I check with the lines below if values were assigned
Cells(2, 4).Value = myArray(4)
Cells(3, 4).Value = myArray(2)
End Sub
Nevertheless values from the cells to do not assign to the array
Moreover when I try to use finalrow as range for the loop I get overflow error (It is not a big problem as there are workarounds, although it would be nice to know what I've done wrong)
Try the code below:
Option Explicit
Sub assigningvalues()
Dim i As Long
Dim myArray(20) As Variant
Dim FinalRow As Long
Dim Sht As Worksheet
Set Sht = ThisWorkbook.Sheets("Sheet1") ' modify "Sheet1" to your sheet's name
With Sht
.Range("A1", .Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
FinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row in column "A"
For i = 2 To FinalRow
myArray(i) = Cells(i, 1).Value
Next i
'I check with the lines below if values were assigned
.Cells(2, 4).Value = myArray(4)
.Cells(3, 4).Value = myArray(2)
End With
End Sub
Note: you can read the contents of the Range to a 1-D Array without a For loop, using Application.Transpose, you need to change the line you define it to:
Dim myArray As Variant
and populate the entire array using:
myArray = Application.Transpose(.Range("A2:A" & FinalRow))
Try the code below:
Sub assigningvalues()
Dim myArray As Variant
ActiveSheet.Range("A1", Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
myArray = ActiveSheet.Range("A1", Range("A1").End(xlDown))
For Each element In myArray
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = element
Next element
End Sub
NOTES: The problem with your above code was, that
ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
returned the absolut number of rows in the sheet, not the used ones. Since your array has length 20 and the sheet about 1 Mio. rows, you have an overflow. you can check this by using
Debug.Print ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
In the above code, after you remove dublicates, you again go down from A1 to the end and save the range to an array. The array myArray now contains all the cell values in your reduced range.
Now you loop over the elements with
For Each element in myArray
and create a new sheet with Workbook.Sheets.Add and assign the name my setting Sheets(index).name = element
The above code should work for you. Few remarks:
Instead of using "ActiveSheet", ThisWorkbook, etc. You should always start a Sub with this:
Dim wb As Workbook
Set wb = ThisWorkbook 'for the workbook containing the code
Set wb = Workbooks(workbookName) 'to reference an other Workbook
'And for all the sheets you are using
Dim ws As Worksheet
Set ws = wb.Sheets(sheetName) 'this way you avoid problems with multiple
workbooks that are open and active or
unactive sheets.
I'm not sure how the logic of loop works.
I have a table at sheet 1 with 105 rows and 120 columns.
I want to do a loop, start with cell J6, copy a range of 100 rows and 16 columns. And transpose and paste at sheet 2 (B1:CW16). Then start with cell K6, copy another range of 100 rows and 16 columns and transpose and paste at sheet 2(B19:CW34). Then start with cell L6 (another 100 rows and 16 columns)and paste at sheet 2. (paste at every 18 rows in sheet 2)
I searched online and have the following code:
Sub transpose()
Dim ColNum As Long
Dim i as long
For ColNum = 10 To 108
LR = Range("B" & Rows.Count).End(xlUp).Row
Sheet1.Activate
Range((Cells(6, ColNum)), (Cells(105, ColNum + 15))).copy
'Transpose
Sheet2.Activate
For i = 1 To LR Step 18
Cells(i, 2).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False, transpose:=True
Next i
Next ColNum
End Sub
This code does not give me what I want. this code copy a range in sheet 1 and paste multiple times in sheet 2 and then copy a second range in sheet 1 and replace everything in sheet 2. How do I modify the code so that I can copy the first range in sheet1, paste to sheet 2 range B1:CW16, then copy the second range in sheet1, and paste to sheet 2 range B19:CW34. (a step of 18 rows at sheet 2)?
Not the most elegant but this should help. I have tried to make the terms as descriptive as possible to help you understand what is going on at each stage.
You can modify these to transpose different numbers of columns and rows from different ranges in the source sheet.
Where to copy from: startCell
When to end copying from: endCell
Where to start pasting to: targetStartCell
How much to transpose: copyRowSize , copyColumnSize
Steps to govern next row destination for transpose: rowStep
Option Explicit
Public Sub TransposeToOtherSheet()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Worksheets("Sheet1") 'change as appropriate
Const numberOfRows As Long = 105
Const numberOfColumns As Long = 120
Const copyRowSize As Long = 100
Const copyColumnSize As Long = 16
Const rowStep As Long = 18
Dim startCell As Range
Dim endCell As Range
Set startCell = ws.Range("J6")
Set endCell = ws.Range("DY6")
Dim targetSheet As Worksheet
Dim targetStartCell As Range
Dim targetRow As Long
Dim targetColumn As Long
Set targetSheet = wb.Worksheets("Sheet2") 'change as appropriate
Set targetStartCell = targetSheet.Range("A1")
targetRow = targetStartCell.Row
targetColumn = targetStartCell.Column
Dim currentColumn As Long
Dim headerRow As Long
headerRow = startCell.Row
Dim targetRowCounter As Long
For currentColumn = startCell.Column To endCell.Column
If targetRowCounter = 0 Then
targetStartCell.Resize(copyColumnSize, copyRowSize) = Application.WorksheetFunction.Transpose(ws.Cells(headerRow, currentColumn).Resize(copyRowSize, copyColumnSize))
Else
' Debug.Print "destination range " & targetSheet.Cells((targetRowCounter * rowStep) + targetRow, targetColumn).Resize(copyColumnSize, copyRowSize).Address
targetSheet.Cells((targetRowCounter * rowStep) + targetRow, targetColumn).Resize(copyColumnSize, copyRowSize) = Application.WorksheetFunction.Transpose(ws.Cells(headerRow, currentColumn).Resize(copyRowSize, copyColumnSize))
End If
targetRowCounter = targetRowCounter + 1
Next currentColumn
End Sub
I have village names in column A.as below mentioned format
VILLAGE
Campbelbay
Carnicobar
Champin
Chowra
Gandhinagar
Kakana
Kapanga
With this format I have around 700 sheets in workbook. I need to get the same transposed to the below mentioned format in Column(cell) Q1.
Campbelbay,Carnicobar,Champin,Chowra,Gandhinagar,Kakana,Kapanga
I have a macro code works for 8 cells and for one sheet, can somebody help me to apply this macro to all sheets with auto select row number.? i.e, Sheets1 has 30 rows, sheet2 has 50 rows and sheet n has n rows.
I do not have much of knowledge in VB.
Following is the code that works for Sheet1:
Ref:
macro to copy and transpose every seventh row and past in new sheet
Public Sub TransposeData()
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long
Application.ScreenUpdating = False
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow Step 8
.Cells(i, "A").Resize(8).Copy
NextRow = NextRow + 1
.Cells(NextRow, "B").PasteSpecial Paste:=xlPasteAll, transpose:=True
Next i
.Rows(NextRow + 1).Resize(LastRow - NextRow).Delete
.Columns(1).Delete
End With
Application.ScreenUpdating = True
End Sub
You will need to loop the sheets collection worksheets and use the .end something like so
Sub test()
Dim w As Excel.Worksheet
Dim r As Excel.Range
For Each w In ThisWorkbook.Worksheets
Set r = Range("a2", w.Range("a1").End(xlDown))
w.Range("q1").Value = Join(Application.Transpose(r.Value), ",")
Next w
End Sub
Couldn't work out whether you wanted them in the same sheet in Q, if so you'll need to change
w.Range("q1").Value = Join(Application.Transpose(r.Value), ",")
to something like
worksheets("result").range("q1").end(xldown).offset(1,0)=
Hope this helps, not fully tested the last line.
Thanks
Try this
Sub test()
Dim w As Excel.Worksheet
Dim r As Excel.Range
For Each w In ThisWorkbook.Worksheets
Set r = w.Range("a2", w.Range("a1").End(xlDown))
w.Range("q1").Value = Join(Application.Transpose(r), ",")
Next w
End Sub
I have multiple sheets in a single workbook with values in 5 rows and 5 columns in each sheet. I need to add the corresponding cell values (eg: D5) in each sheet and dump it in a new sheet in its D5. I could do it for one particular cell, but I'm confused on how to do it in nested for loops. I've only been doing vba for a day.. so please help. Thanks.
Sub Macro1()
Dim i, val
'Select worksheets
For i = 7 To Sheets.Count
val = val + Sheets(i).Range("e6")
Next
Sheets("Summation").Range("e6") = val
End Sub
Is this what you want?
Sub Sample()
Dim ws As Worksheet, wsSumry As Worksheet
Dim startRow As Long, StartCol As Long
Dim i As Long, j As Long
Dim ar(1 To 4, 1 To 4) As Variant
'~~> Start row and start column
startRow = 2: StartCol = 2
'~~> Summary sheet
Set wsSumry = Sheet1
'~~> Looping through each worksheet
For Each ws In ThisWorkbook.Worksheets
'~~> Check if it is not the summary sheet
If ws.Name <> wsSumry.Name Then
'~~> Loop through the row and columns and
'~~> Store it in an array
For i = startRow To (startRow + 3)
For j = StartCol To (StartCol + 3)
ar(i - 1, j - 1) = ar(i - 1, j - 1) + ws.Cells(i, j)
Next j
Next i
End If
Next
'~~> Write array to summary sheet
wsSumry.Range("B2").Resize(UBound(ar), UBound(ar)).Value = ar
End Sub
Screenshot
You can use Copy and Add technique, cycling through each sheet that isn't the summisary sheet and then pasting its values in to the final sheet (while adding them) - something like:
Dim b As Worksheet
Set b = ThisWorkbook.Worksheets("Sheet4")
b.range("A1:A2").clear
For Each a In ThisWorkbook.Sheets
If Not a.Name = b.Name Then
a.Range("A1:A2").Copy
b.Range("A1:A2").PasteSpecial operation:=xlAdd
End If
Next
Obviously your range can be defined in place of "A1:A2"
I'm sure there's a more "code" way of adding arrays together but in Excel this might prove good for you.
I have a large numbers of worksheets in a Workbook.
I want to insert a new row at the top of each worksheet (A:A) and insert the name of each worksheet into cells (B1:G1) for all worksheets.
I have the first portion, but am a little stuck on the second part (i.e., adding the worksheet name). I would appreciate some help.
Corrected CODE:
Sub NameSheets()
Dim sheetnm() As String
ReDim sheetnm(1 To Sheets.Count)
Dim i As Long
Dim ws As Worksheet
For i = 1 To Sheets.Count
Sheets(i).Rows("1:1").Insert Shift:=xlDown
sheetnm(i) = Sheets(i).Name
Sheets(i).Range("B1:G1") = Sheets(i).Name
Next i
End Sub
Range ("B1:G1") = ActiveSheet.name . This will add the current worksheet name to all 6 columns
I modified your code. Try this:
Dim sheet As Worksheet
For Each sheet In Worksheets
sheet.Rows("1:1").Insert Shift:=xlDown
sheet.Range("B1:G1").Value = sheet.Name
Next sheet
This will cycle through the sheets twice. The first to add the first row and create an array of the sheet names. The second to input that list in the first row starting in B1:
Sub NameSheets()
Dim sheetnm() As String
ReDim sheetnm(1 To Sheets.Count)
Dim i As Long
For i = 1 To Sheets.Count
Sheets(i).Rows("1:1").Insert Shift:=xlDown
sheetnm(i) = Sheets(i).Name
Next i
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
ws.Range("B1").Resize(, UBound(sheetnm)).Value = sheetnm
Next ws
End Sub