excelvbastringpattern-matchingtransfer# With excel vba, transferring data to another page with a specific pattern

I would like to transfer the values selected by users from dropdown lists locating within the range B4:M29 to the range B6:G56 on another sheet with a specific pattern. With this pattern, the values in 'B' column/sheet1 will be header in 'A' column/sheet5 then the remaining consecutive values will be transferred as they follows each other by moving to the next line from the middle. As I try to show schematically below:

```
Sub Group6_Click()
Dim wSheet As Worksheet
Dim vFile As Variant
Dim sFile As String
Dim j As String
Dim wb As Workbook
Dim OldData As Range
Dim NewData As Range
Set OldData = ThisWorkbook.Sheets("sheet1").Range("B4:M29")
Set NewData = ThisWorkbook.Sheets("sheet5").Range("A6:L31")
Set wb = ThisWorkbook
OldData.Value = NewData.Value
Set wSheet = ActiveSheet
sFile = Replace(Replace(wb.Name, "KV_Envanter", ""), ".", "_") _
& "_" _
& Format(Now(), "yyyymmdd\_hhmm") _
& ".pdf"
sFile = ThisWorkbook.Path & "\" & sFile
vFile = Application.GetSaveAsFilename _
(InitialFileName:=sFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If vFile <> "False" Then
MsgBox "The report is ready."
Sheets("sheet5").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=vFile, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Sheets("sheet5").PageSetup.Orientation = xlLandscape
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.FitToPagesWide = 1
End With
End If
End Sub
```

Solution

```
Option Explicit
Sub demo()
Dim oldData As Range, arrData, arrRes()
Dim newData As Range
Dim newColCnt As Integer, i As Long, j As Long, k As Long
Dim oldColCnt As Integer
' Load data
Set oldData = ThisWorkbook.Sheets("sheet1").Range("B4:M29")
arrData = oldData
' redim array for new data
oldColCnt = UBound(arrData, 2)
newColCnt = oldColCnt / 2 + 1
ReDim arrRes(1 To UBound(arrData) * 2, 1 To newColCnt)
k = 1
' Loop through each row to transform data
For i = 1 To UBound(arrData)
For j = 1 To newColCnt Step 1
arrRes(k, j) = arrData(i, j)
If j > 1 And j + newColCnt < oldColCnt + 2 Then
arrRes(k + 1, j) = arrData(i, j + newColCnt - 1)
End If
Next
k = k + 2
Next
' Write new data to sheet
Set newData = ThisWorkbook.Sheets("sheet5").Range("A6")
newData.Resize(UBound(arrData) * 2, newColCnt).Value = arrRes
End Sub
```

- Build vertical summary from Columns with Count
- Excel - Create a Unit Conversion sheet - Multiple links
- update cell when column header matches a list
- Delete text in cell subject to Worksheet_Change
- Counting the number of visible rows after autofilter
- Excel 2007: AVERAGEIF, SUMIF, COUNTIF, MAXIF, MINIF across multiple sheets, multple rows
- Import CSV data from a txt file skipping the first line and adding headers
- Simplifying SumIFs formulas for efficient excel formula
- I'd like to find out how to find the current streak of non-negative numbers in a row of data in Excel
- ValueError: Invalid character found in sheet title
- decrypt excel files
- Excel table search funcion that looks for partial string match
- Combine macros to filter on today's and tomorrow's date
- Converting line breaks to commas in excel sheet using Powershell
- Combinations of numbers arranged side by side as many as a random number (VBA)
- How can I remove ONLY leading and trailing spaces while leaving spaces in between words alone with an excel formula?
- VBA Date as integer
- Sliding Window Auto Increment Range
- Count cells with different conditional ranges
- Turning flattened pivots data into tables -Error tables can't overlap - Excel Vba
- How do I get only a specific part of a cell in Excel or Numbers?
- Calculate the Legendre symbol of two integers in Excel
- Unable to get text wrapping or vertical centering to work with xlsxwriter
- Number stored as text warning in excel using POI
- VBA Excel paste to the columns in regular intervals
- Convert filtered values from formulas to values
- Sorting Dictionary by nested class objects data [VBA]
- Events does not appear when making an Outlook query from Excel
- The script works well when I use MSXML2.XMLHTTP.6.0, but it fails miserably when I switch to MSXML2.serverXMLHTTP.6.0
- How to convert text string (d h m s) to time format in excel