PDA

View Full Version : fastest way to copy multiple range to multiple sheets



chingilou
03-20-2021, 01:38 AM
hi
in first my level of vba is 0.01 then sorry if the problems was answered before
i have for exemple in my sheet1 A14:B195,D14:D195,C14:C195..in this order
i want to past to sheet2 start in cell B2, sheet4 start in F10,...
how i do without time lag
thanks

rollis13
03-20-2021, 02:02 AM
Adding link for crosspost: LINK (https://www.mrexcel.com/board/threads/fastest-way-to-copy-multiple-range-to-multiple-sheets.1165552/)

chingilou
03-20-2021, 02:25 AM
and ?

jolivanes
03-22-2021, 03:59 PM
What do you mean by this: "And ?"




As per request.

Sub Maybe()
Dim a, aa, aaa
a = Sheets("Sheet1").Range("A14:B195").Value
aa = Sheets("Sheet1").Range("D14195").Value
aaa = Sheets("Sheet1").Range("A14:B195").Value
Sheets("Sheet2").Range("B2").Resize(Ubound(a), Ubound(a, 2)).Value = a
Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Offset(1) = aa
Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(Ubound(aaa), Ubound(aaa, 2)) = aaa
Sheets("Sheet4").Range("F10").Resize(Ubound(a), Ubound(a, 2)).Value = a
Sheets("Sheet4").Cells(Rows.Count, 6).End(xlUp).Offset(1) = aa
Sheets("Sheet4").Cells(Rows.Count, 6).End(xlUp).Offset(1).Resize(Ubound(aaa), Ubound(aaa, 2)) = aaa
End Sub

SamT
03-22-2021, 05:09 PM
Laughing Smiley = Colon+D

I just Disabled Smilies in Text in OP's post

jolivanes
03-22-2021, 06:14 PM
Hi Sam
Does not make much of a difference for the OP I think as what I gave was a bunch of no good anyway.
His description leaves a lot to be desired. I was waiting for a comeback telling us that "it does not work!"

SamT
03-22-2021, 09:13 PM
Except for a couple of typos, it looked good to me. Not the way I would try it, maybe better.

Do you know if you can "paste" one column of a 3 column array?
Arr = Range("A14:D159").Value
OtherRange = Arr(1)
OtherRange2 = Arr(3)
I've never tried.

I also never tried Arr2(2) = Arr(3)

jolivanes
03-22-2021, 10:55 PM
This is what I use for single column output of a multi dimensional array. This time without typos I hope!!!

Sub Try_So()
Dim arr1, sh1 As Worksheet
Set sh1 = Worksheets("Sheet1")
arr1 = sh1.Range("A2:D" & sh1.Cells(Rows.Count, 1).End(xlUp).Row).Value
sh1.Cells(2, 7).Resize(UBound(arr1)) = Application.Index(arr1, , 1) '<----(arr1,,2) for Column B, (arr1,,3) for Column C etc.
End Sub

SamT
03-22-2021, 11:02 PM
Thanks. That just went into my Personal.xls

jolivanes
03-22-2021, 11:26 PM
It's my pleasure Sam

jolivanes
03-23-2021, 09:12 AM
You don't want to have to go and change the code everytime when wanting to output a different column.
This might be better suited.

Sub Try_So()
Dim arr1, sh1 As Worksheet, i As Long
Set sh1 = Worksheets("Sheet1")
arr1 = sh1.Range("A2:D" & sh1.Cells(Rows.Count, 1).End(xlUp).Row).Value
i = InputBox("Which column from the array do you want printed?", "Enter a number not more than " & UBound(arr1, 2), 1)
If i > UBound(arr1, 2) Then MsgBox "Not that many Columns in the Array. Try again.": Exit Sub
sh1.Cells(2, 7).Resize(UBound(arr1)) = Application.Index(arr1, , i)
End Sub

You can also adapt it for the Range(number of columns in the array) beforehand if you want.

snb
03-23-2021, 09:20 AM
Had been waiting for you all along:

https://www.snb-vba.eu/VBA_Arrays_en.html#L_6.0.4

jolivanes
03-23-2021, 10:20 AM
That's it.
Here I thought I would have a relaxing afternoon but no, need to study again!
Thank you sir (I take the liberty of assuming that)

chingilou
03-25-2021, 05:18 PM
sorry i was traveling so practically disconnected
my english is translated by google that's why the errors sorry!
I resume
I have several sheets and I only work from the first sheet
I have a table on this sheet1 whose rows I want to copy on the other sheets (quotes and invoices)
the rows are not the same (number, text, date) so union impossible
and the order is not the same in the sheets
example in sheets 1 A14: A195 B14: B195 C14: C195 D14: D195 will be copied in sheet2 thus A..B..D..C..C * D
in sheet 3 as well A..B..D..D * (VAT + 1) .. C..C * D * (VAT + 1)
I managed to make macros to copy but I had timelags

jolivanes
03-25-2021, 06:29 PM
No Timelag

Sub Maybe()
Dim ArrShts, ArrCols, a
Dim i As Long, k As Long, j As Long
ArrShts = Array("Sheet2", "Sheet3") '<-----Change as required
ArrCols = Array(1, 2, 4, 3) '<----- Column numbers order of paste
a = Sheets("Acceuil").Range("A14:D195").Value
For i = LBound(ArrShts) To UBound(ArrShts)
k = 1
With Sheets(ArrShts(i))
For j = LBound(ArrCols) To UBound(ArrCols)
.Cells(14, ArrCols(j)).Resize(UBound(a)) = Application.Index(a, , k)
k = k + 1
Next j
End With
Next i
End Sub
or
Waiting for snb to show us how to use a variable for the 182 and to put the 2 Sheet2 and Sheet3 lines into one line

Sub Maybe_2()
Dim a, b
a = Sheets("Acceuil").Range("A14:D" & Sheets("Acceuil").Cells(Rows.Count, 1).End(xlUp).Row).Value
b = Application.Index(a, [Row(1:182)], Array(1, 2, 4, 3))
Sheets("Sheet2").Cells(1, 1).Resize(UBound(b), UBound(b, 2)) = b
Sheets("Sheet3").Cells(1, 1).Resize(UBound(b), UBound(b, 2)) = b
End Sub

chingilou
03-25-2021, 08:17 PM
good idea very promising as long as I understand it completely
for the moment I can't adapt it to my file
the Column numbers order of paste change from sheet to another
do i have to put a macro with the correct order for each sheet

jolivanes
03-25-2021, 09:18 PM
Re: "do i have to put a macro with the correct order for each sheet"
In that case, things change. I don't know into how many sheets you need to paste and I also don't know the order of the columns.
In your attachment, you have hidden Columns as well as Rows. Nothing explained about that.
Everything needs to be explained for people that have the time and are willing to help you to understand.

SamT
03-25-2021, 11:02 PM
the Column numbers order of paste change from sheet to another
I usually handle things like this with custom VBA Sheet Property Gets

In each Sheet's code page:

Public Property Get ColumnOrder() As Variant
ColumnOrder = Array(1,2,4,3) 'Edit array to suit sheet
End PropertyMany Sheets can have the same Property name.

Then adjust the Macro to use each sheet's Get property

Blah Blah
Dim Sh As Sheet
For Each Sh in Sheets
On Error Resume Next
CO = Sh.ColumnOrder
If ISEmpty(CO) Then GoTo SheetNext
'Code to paste to Sh by CO '(Column Order)
SheetNext:
Next Sh
'End Blah Blah

snb
03-26-2021, 04:33 AM
Sub snb()
sn = Feuil1.Cells(14, 1).CurrentRegion.Offset(1)
Feuil2.Cells(14, 3).Resize(ubound(sn), 4) = Application.Index(sn, Evaluate("row(1:" & UBound(sn) & ")"), Array(1, 2, 4, 3))
End Sub

snb
03-27-2021, 02:22 AM
Extended:


Sub snb()
sn = Feuil1.Cells(14, 1).CurrentRegion.Offset(1)

Feuil2.Cells(14, 3).Resize(ubound(sn), 4) = Application.Index(sn, Evaluate("row(1:" & UBound(sn) & ")"), Array(1, 2, 4, 3))
Feuil3.Cells(14, 3).Resize(ubound(sn), 4) = Application.Index(sn, Evaluate("row(1:" & UBound(sn) & ")"), Array(1, 2, 5, 3))
Feuil4.Cells(14, 3).Resize(ubound(sn), 4) = Application.Index(sn, Evaluate("row(1:" & UBound(sn) & ")"), Array(1, 2, 6, 3))
Feuil5.Cells(19, 3).Resize(ubound(sn), 5) = Application.Index(sn, Evaluate("row(1:" & UBound(sn) & ")"), Array(1, 2, 9, 9, 3))
End Sub

chingilou
03-27-2021, 03:24 AM
thanks snb it's exactly what i do but i can't post yesterday

chingilou
03-27-2021, 03:28 AM
:crying: i tried to post yesterday several times but a message came all the time something like the post reached its limit

jolivanes
03-27-2021, 02:40 PM
Thanks both Sam & snb.
Gives me something to work on/with again.

chingilou
03-27-2021, 03:29 PM
sorry that's right
as i say what i liked to post yesterday was my thanks for you and samT
if I could have posted my new file you will see a module with name jolivanes
nevertheless thank you very much Jolivanes ,samT & snb

chingilou
06-11-2022, 03:50 AM
hello everyone sorry to resume this old thread
how to do with snb code

Sub snb()
Dim sn As Variant
sn = Feuil1.Cells(10, 1).CurrentRegion.Offset(1)
Feuil2.Cells(14, 1).Resize(UBound(sn), 4) = Application.Index(sn, Evaluate("row(7:" & UBound(sn) & ")"), Array(1, 2, 4, 3))
Feuil3.Cells(14, 1).Resize(UBound(sn), 4) = Application.Index(sn, Evaluate("row(7:" & UBound(sn) & ")"), Array(1, 2, 5, 3))
Feuil4.Cells(14, 1).Resize(UBound(sn), 4) = Application.Index(sn, Evaluate("row(7:" & UBound(sn) & ")"), Array(1, 2, 6, 3))
Feuil5.Cells(19, 3).Resize(UBound(sn), 3) = Application.Index(sn, Evaluate("row(7:" & UBound(sn) & ")"), Array(1, 2, 4))
Feuil5.Cells(19, 7).Resize(UBound(sn), 1) = Application.Index(sn, Evaluate("row(7:" & UBound(sn) & ")"), Array(3))
End Sub
if i don't want to copy what is below the table (outside the table)
the table starts in 10.1 and ends in maximum in 196.6

chingilou
06-15-2022, 04:51 PM
an empty line added below the table solve the problem:banghead::banghead::banghead: